From 3d893f4b170a43e746d65496e254afd8c4571f14 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johannes=20Wei=C3=9Fl?= Date: Thu, 18 Jul 2013 22:04:34 +0200 Subject: Fix httpd config option 'keep_alive_timeout' The documentation states that the value is in seconds, which was true when using the Apache like configuration file, but not true when using the proplist style configuration. --- lib/inets/src/http_server/httpd_conf.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index b3ca13e2fe..27446ca7fe 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -798,6 +798,8 @@ store({log_format, LogFormat}, _ConfigList) store({server_tokens, ServerTokens} = Entry, _ConfigList) -> Server = server(ServerTokens), {ok, [Entry, {server, Server}]}; +store({keep_alive_timeout, KeepAliveTimeout}, _ConfigList) -> + {ok, {keep_alive_timeout, KeepAliveTimeout * 1000}}; store(ConfigListEntry, _ConfigList) -> {ok, ConfigListEntry}. -- cgit v1.2.3 From 720721e41c90cc2105326cf0e84accae75a1786a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johannes=20Wei=C3=9Fl?= Date: Thu, 18 Jul 2013 22:09:51 +0200 Subject: Fix httpd config option 'script_timeout' This fixes the usage of the httpd configuration option 'script_timeout', which got ignored before. The documentation states that the value is in seconds, which was true when using the Apache like configuration file, but not true when using the proplist style configuration. --- lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl | 2 +- lib/inets/src/http_server/mod_cgi.erl | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl index d3f67eb77a..8c91b6f430 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl @@ -338,7 +338,7 @@ exec_script(false,Info,Script,_AfterScript,_RequestURI) -> %% proxy(#mod{config_db = ConfigDb} = Info, Port) -> - Timeout = httpd_util:lookup(ConfigDb, cgi_timeout, ?DEFAULT_CGI_TIMEOUT), + Timeout = httpd_util:lookup(ConfigDb, script_timeout, ?DEFAULT_CGI_TIMEOUT), proxy(Info, Port, 0, undefined,[], Timeout). proxy(Info, Port, Size, StatusCode, AccResponse, Timeout) -> diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index f1b73810e6..d933b0a4ba 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -131,9 +131,9 @@ store({script_nocache, Value} = Conf, _) {ok, Conf}; store({script_nocache, Value}, _) -> {error, {wrong_type, {script_nocache, Value}}}; -store({script_timeout, Value} = Conf, _) +store({script_timeout, Value}, _) when is_integer(Value), Value >= 0 -> - {ok, Conf}; + {ok, {script_timeout, Value * 1000}}; store({script_timeout, Value}, _) -> {error, {wrong_type, {script_timeout, Value}}}. @@ -238,7 +238,7 @@ send_request_body_to_script(ModData, Port) -> end. deliver_webpage(#mod{config_db = Db} = ModData, Port) -> - Timeout = cgi_timeout(Db), + Timeout = script_timeout(Db), case receive_headers(Port, httpd_cgi, parse_headers, [<<>>, [], []], Timeout) of {Headers, Body} -> @@ -341,8 +341,8 @@ script_elements(#mod{method = "PUT", entity_body = Body}, _) -> script_elements(_, _) -> []. -cgi_timeout(Db) -> - httpd_util:lookup(Db, cgi_timeout, ?DEFAULT_CGI_TIMEOUT). +script_timeout(Db) -> + httpd_util:lookup(Db, script_timeout, ?DEFAULT_CGI_TIMEOUT). %% Convert error to printable string %% -- cgit v1.2.3 From 21095e6830f37676dd29c33a590851ba2c76499b Mon Sep 17 00:00:00 2001 From: Pierre Fenoll Date: Tue, 10 Sep 2013 15:48:29 +0100 Subject: Remove ^L characters hidden randomly in the code. Not those used in text files as delimiters. While working on a tool that processes Erlang code and testing it against this repo, I found out about those little sneaky 0xff. I thought it may be of help to other people build such tools to remove non-conforming-to-standard characters. --- erts/emulator/beam/beam_emu.c | 3 -- erts/emulator/beam/beam_load.c | 16 --------- erts/emulator/drivers/unix/ttsl_drv.c | 8 ++--- erts/emulator/drivers/win32/win_efile.c | 2 +- erts/emulator/test/call_trace_SUITE.erl | 2 +- erts/emulator/test/driver_SUITE.erl | 6 ++-- erts/emulator/test/statistics_SUITE.erl | 12 +++---- erts/emulator/test/trace_SUITE.erl | 2 +- erts/emulator/test/trace_port_SUITE.erl | 2 +- lib/compiler/src/beam_clean.erl | 2 +- lib/compiler/src/beam_type.erl | 2 +- lib/compiler/src/compile.erl | 4 +-- lib/compiler/src/core_scan.erl | 4 +-- lib/compiler/src/v3_core.erl | 2 +- lib/compiler/src/v3_kernel.erl | 8 ++--- .../dbg_ui_SUITE_data/manual_data/src/lists1.erl | 4 +-- lib/debugger/test/int_SUITE_data/lists1.erl | 4 +-- lib/debugger/test/int_SUITE_data/my_lists.erl | 16 ++++----- .../src/compiler/beam_clean.erl | 2 +- .../options1_SUITE_data/src/compiler/beam_type.erl | 2 +- .../options1_SUITE_data/src/compiler/compile.erl | 4 +-- .../options1_SUITE_data/src/compiler/core_scan.erl | 4 +-- .../src/compiler/sys_pre_expand.erl | 4 +-- .../options1_SUITE_data/src/compiler/v3_core.erl | 2 +- .../options1_SUITE_data/src/compiler/v3_kernel.erl | 6 ++-- lib/erl_interface/src/legacy/erl_eterm.c | 2 +- lib/erl_interface/test/all_SUITE_data/ei_runner.c | 4 +-- lib/erl_interface/test/all_SUITE_data/runner.c | 4 +-- lib/erl_interface/test/ei_accept_SUITE.erl | 2 +- lib/erl_interface/test/erl_connect_SUITE.erl | 2 +- lib/erl_interface/test/erl_eterm_SUITE.erl | 10 +++--- .../test/erl_eterm_SUITE_data/eterm_test.c | 8 ++--- lib/stdlib/src/dict.erl | 2 +- lib/stdlib/src/erl_eval.erl | 4 +-- lib/stdlib/src/erl_tar.erl | 4 +-- lib/stdlib/src/filelib.erl | 4 +-- lib/stdlib/src/io_lib.erl | 2 +- lib/stdlib/src/lists.erl | 4 +-- lib/stdlib/src/string.erl | 4 +-- lib/stdlib/test/slave_SUITE.erl | 2 +- lib/test_server/src/ts.erl | 2 +- lib/tools/emacs/erlang-start.el | 2 +- lib/tools/emacs/erlang.el | 38 +++++++++++----------- lib/tools/src/tags.erl | 4 +-- lib/tools/test/eprof_SUITE_data/eed.erl | 8 ++--- lib/xmerl/src/xmerl_regexp.erl | 12 +++---- system/doc/top/src/erl_html_tools.erl | 2 +- 47 files changed, 115 insertions(+), 134 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index da36c4437e..78ab6fa30f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -5654,7 +5654,6 @@ build_stacktrace(Process* c_p, Eterm exc) { return res; } - static BeamInstr* call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func) { @@ -5702,7 +5701,6 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func) return ep->addressv[erts_active_code_ix()]; } - static Export* apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, Eterm* reg) { @@ -6208,7 +6206,6 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) return make_fun(funp); } - int catchlevel(Process *p) { diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 4193eb4f3f..938fd8f2c9 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -535,7 +535,6 @@ static int must_swap_floats; Uint erts_total_code_size; /**********************************************************************/ - void init_load(void) { FloatDef f; @@ -1209,7 +1208,6 @@ verify_chunks(LoaderState* stp) return 0; } - static int load_atom_table(LoaderState* stp) { @@ -1255,7 +1253,6 @@ load_atom_table(LoaderState* stp) return 0; } - static int load_import_table(LoaderState* stp) { @@ -1308,7 +1305,6 @@ load_import_table(LoaderState* stp) return 0; } - static int read_export_table(LoaderState* stp) { @@ -1641,7 +1637,6 @@ read_line_table(LoaderState* stp) return 0; } - static int read_code_header(LoaderState* stp) { @@ -1711,7 +1706,6 @@ read_code_header(LoaderState* stp) return 0; } - #define VerifyTag(Stp, Actual, Expected) \ if (Actual != Expected) { \ LoadError2(Stp, "bad tag %d; expected %d", Actual, Expected); \ @@ -1730,7 +1724,6 @@ read_code_header(LoaderState* stp) #define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm)))) - static int load_code(LoaderState* stp) { @@ -2512,7 +2505,6 @@ load_code(LoaderState* stp) return retval; } - #define succ(St, X, Y) ((X).type == (Y).type && (X).val + 1 == (Y).val) #define succ2(St, X, Y) ((X).type == (Y).type && (X).val + 2 == (Y).val) #define succ3(St, X, Y) ((X).type == (Y).type && (X).val + 3 == (Y).val) @@ -3958,7 +3950,6 @@ tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, } - /* * Freeze the code in memory, move the string table into place, * resolve all labels. @@ -4276,7 +4267,6 @@ freeze_code(LoaderState* stp) return 0; } - static void final_touch(LoaderState* stp) { @@ -4378,7 +4368,6 @@ final_touch(LoaderState* stp) } } - static int transform_engine(LoaderState* st) { @@ -4716,7 +4705,6 @@ transform_engine(LoaderState* st) return rval; } - static void short_file(int line, LoaderState* stp, unsigned needed) { @@ -4724,7 +4712,6 @@ short_file(int line, LoaderState* stp, unsigned needed) stp->file_name, needed); } - static void load_printf(int line, LoaderState* context, char *fmt,...) { @@ -5190,7 +5177,6 @@ native_addresses(Process* p, Eterm mod) return result; } - /* * Builds a list of all exported functions in the given module: * [{Name, Arity},...] @@ -5240,7 +5226,6 @@ exported_from_module(Process* p, /* Process whose heap to use. */ return result; } - /* * Returns a list of all attributes for the module. * @@ -5281,7 +5266,6 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ return result; } - /* * Returns a list containing compilation information. * diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 1e436830e7..491e0a090e 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -745,7 +745,7 @@ static Sint16 get_sint16(char *s) { return ((*s << 8) | ((byte*)s)[1]); } - + static int start_lbuf(void) { if (!lbuf && !(lbuf = ( Uint32*) driver_alloc(lbuf_size * sizeof(Uint32)))) @@ -1091,7 +1091,7 @@ static int move_cursor(int from, int to) move_left(-dc); return TRUE; } - + static int start_termcap(void) { int eres; @@ -1187,7 +1187,7 @@ static int move_down(int n) tputs(down, 1, outc); return TRUE; } - + /* * Updates cols if terminal has resized (SIGWINCH). Should be called @@ -1209,7 +1209,7 @@ static void update_cols(void) cols = width; } } - + /* * Put a terminal device into non-canonical mode with ECHO off. diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index b36a103f8e..319065f57b 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1216,7 +1216,7 @@ int flags; return 1; } - + /* * is_root_unc_name - returns TRUE if the argument is a UNC name specifying * a root share. That is, if it is of the form \\server\share\. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index eaecd32f95..ef1f2aa04c 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -1193,7 +1193,7 @@ bs_sum_b(Acc, <<>>) -> Acc. - + %%% Help functions. expect() -> diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 104bdf8aec..7087542899 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -367,7 +367,7 @@ compare(Got, Expected) -> ?t:fail(got_bad_data) end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Driver timer test suites %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -515,7 +515,7 @@ try_change_timer(Port, Timeout) -> ?line test_server:fail("driver failed to timeout") end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Queue test suites %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -719,7 +719,7 @@ deq(Port, Size) -> read_head(Port, Size) -> erlang:port_control(Port, ?READ_HEAD, <>). - + driver_unloaded(doc) -> []; driver_unloaded(suite) -> diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index a93dd309c1..c428be6c5a 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -75,7 +75,7 @@ end_per_group(_GroupName, Config) -> Config. - + %%% Testing statistics(wall_clock). @@ -121,7 +121,7 @@ wall_clock_update1(N) when N > 0 -> wall_clock_update1(0) -> ok. - + %%% Test statistics(runtime). @@ -199,7 +199,7 @@ do_much(N) -> _ = 4784728478274827 * 72874284728472, do_much(N-1). - + reductions(doc) -> "Test that statistics(reductions) is callable, and that " "Total_Reductions and Reductions_Since_Last_Call make sense. " @@ -246,7 +246,7 @@ reductions_big_loop() -> reductions_big_loop() end. - + %%% Tests of statistics(run_queue). @@ -295,7 +295,7 @@ hog_iter(N, Mon) when N > 0 -> end; hog_iter(0, Mon) -> ?line hog_iter(10000, Mon). - + %%% Tests of statistics(scheduler_wall_time). scheduler_wall_time(doc) -> @@ -363,7 +363,7 @@ load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> [100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)]; load_percentage([], []) -> []. - + garbage_collection(doc) -> "Tests that statistics(garbage_collection) is callable. " "It is not clear how to test anything more."; diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 0f513f0dcb..2251575e5a 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1427,7 +1427,7 @@ receive_nothing() -> ok end. - + %%% Models for various kinds of processes. process(Dest) -> diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index cc2eadafbc..99df8da107 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -648,7 +648,7 @@ fun_spawn(Fun, Opts) -> % [] % end. - + %%% Models for various kinds of processes. %% Sends messages when ordered to. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index e208ffec1f..9d89e21a4e 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -86,7 +86,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3b51216a6c..3ec57a67da 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -600,7 +600,7 @@ checkerror_1([], OrigIs) -> OrigIs. checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 802e3dfa2f..47d446273b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1556,7 +1556,7 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. - + -spec options() -> 'ok'. options() -> @@ -1593,7 +1593,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 0ca2f57dde..c0dfecd1dc 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -96,7 +96,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; %' stupid emacs string_thing($") -> "string". %" stupid emacs - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -214,7 +214,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 1195937d91..01bb8635cd 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1912,7 +1912,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end, (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 2b2b8bf550..65f1251099 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -160,8 +160,8 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. - - + + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -834,7 +834,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1428,7 +1428,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end end. - + %% ubody_used_vars(Expr, State) -> [UsedVar] %% Return all used variables for the body sequence. Much more %% efficient than using ubody/3 if the body contains nested letrecs. diff --git a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl +++ b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/lists1.erl b/lib/debugger/test/int_SUITE_data/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/int_SUITE_data/lists1.erl +++ b/lib/debugger/test/int_SUITE_data/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/my_lists.erl b/lib/debugger/test/int_SUITE_data/my_lists.erl index 98eb4396e3..f9399b1085 100644 --- a/lib/debugger/test/int_SUITE_data/my_lists.erl +++ b/lib/debugger/test/int_SUITE_data/my_lists.erl @@ -237,7 +237,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -299,7 +299,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -698,7 +698,7 @@ flatlength_1([H|T], L) when list(H) -> flatlength_1([H|T], L) -> flatlength_1(T, L + 1); flatlength_1([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -760,7 +760,7 @@ keymap_1(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_1(Fun, ExtraArgs, Index, Tail)]; keymap_1( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -1162,7 +1162,7 @@ flatlength_2([H|T], L) when list(H) -> flatlength_2([H|T], L) -> flatlength_2(T, L + 1); flatlength_2([], L) -> L. - + %% keymember_2(Key, Index, [Tuple]) %% keysearch_2(Key, Index, [Tuple]) %% keydelete_2(Key, Index, [Tuple]) @@ -1224,7 +1224,7 @@ keymap_2(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_2(Fun, ExtraArgs, Index, Tail)]; keymap_2( _, _ , _, []) -> []. - + %% all_2(Predicate, List) %% any_2(Predicate, List) %% map_2(Function, List) @@ -1624,7 +1624,7 @@ flatlength_3([H|T], L) when list(H) -> flatlength_3([H|T], L) -> flatlength_3(T, L + 1); flatlength_3([], L) -> L. - + %% keymember_3(Key, Index, [Tuple]) %% keysearch_3(Key, Index, [Tuple]) %% keydelete_3(Key, Index, [Tuple]) @@ -1686,7 +1686,7 @@ keymap_3(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_3(Fun, ExtraArgs, Index, Tail)]; keymap_3( _, _ , _, []) -> []. - + %% all_3(Predicate, List) %% any_3(Predicate, List) %% map_3(Function, List) diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl index 04225e9bd0..4fc4e89ce9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl @@ -80,7 +80,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl index d2ac3fcd99..f59cc897d6 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl @@ -456,7 +456,7 @@ are_live_regs_determinable([{'%live',_}|_]) -> true; are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is); are_live_regs_determinable([]) -> false. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl index 2b6d14e300..9b56d384ab 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl @@ -990,7 +990,7 @@ listing(LFun, Ext, St) -> Es = [{Lfile,[{none,compile,write_error}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. - + options() -> help(standard_passes()). @@ -1022,7 +1022,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl index f4e609bf5b..879af3efea 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl @@ -123,7 +123,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; string_thing($") -> "string". - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -241,7 +241,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl index 41b7cb248d..590cc682c9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl @@ -647,7 +647,7 @@ new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> ++ "-fun-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. - + %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. @@ -881,7 +881,7 @@ bin_expand_strings(Es) -> end, Es1, S); (E, Es1) -> [E|Es1] end, [], Es). - + %% new_var_name(State) -> {VarName,State}. new_var_name(St) -> diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl index c96837ab5e..45a8bc4ad9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl @@ -1127,7 +1127,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end, (core_lib:get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl index d7c3e1add9..ecba19b1d1 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl @@ -129,7 +129,7 @@ function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) -> %%B1 = B0, St3 = St2, %Null second pass {#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab}, func=F,arity=Arity,vars=Kvs,body=B1},St3}. - + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -719,7 +719,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1143,7 +1143,7 @@ arg_val(Arg) -> #k_bin_end{} -> 0; #k_binary{} -> 0 end. - + %% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}. %% Tag the body sequence with its used variables. These bodies %% either end with a #k_break{}, or with #k_return{} or an expression diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 7ca4f430de..636d26b24b 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -686,7 +686,7 @@ int erl_length(const ETERM *ep) return n; } - + /*********************************************************************** * I o l i s t f u n c t i o n s * diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c index 205f911e38..cdf32b48c4 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.c +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c @@ -77,7 +77,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -182,7 +182,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c index a474c17722..038d651275 100644 --- a/lib/erl_interface/test/all_SUITE_data/runner.c +++ b/lib/erl_interface/test/all_SUITE_data/runner.c @@ -78,7 +78,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -188,7 +188,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 48469e68dc..642809ea7a 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -155,7 +155,7 @@ start_einode(Einode, N, Host, Port) -> ok. - + %%% Interface functions for ei (erl_interface) functions. ei_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index bd54013402..c8becc760c 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -106,7 +106,7 @@ erl_reg_send(Config) when is_list(Config) -> ?line runner:recv_eot(P), ok. - + %%% Interface functions for erl_interface functions. erl_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 10a27e48e3..100e9b6f68 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -108,7 +108,7 @@ end_per_group(_GroupName, Config) -> Config. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 1. B a s i c t e s t s @@ -196,7 +196,7 @@ t_erl_free_compound(Config) when is_list(Config) -> ?line runner:test(?t_erl_free_compound), ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 2. C o n s t r u c t i n g t e r m s @@ -521,7 +521,7 @@ t_erl_cons(Config) when is_list(Config) -> - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -669,7 +669,7 @@ t_erl_element(Config) when is_list(Config) -> ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 4. I / O l i s t f u n c t i o n s @@ -894,7 +894,7 @@ iolist_to_string(Port, Term) -> 'NULL' -> 'NULL' end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 5. M i s c e l l a n o u s T e s t s diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c index 80d7f69520..94959187b9 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c +++ b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c @@ -269,7 +269,7 @@ TESTCASE(t_erl_free_compound) report(1); } - + /*********************************************************************** * * 2. C o n s t r u c t i n g t e r m s @@ -1047,7 +1047,7 @@ TESTCASE(t_erl_cons) - + /*********************************************************************** * * 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -1296,7 +1296,7 @@ TESTCASE(extractor_macros) } - + /*********************************************************************** * * 4. I / O l i s t f u n c t i o n s @@ -1393,7 +1393,7 @@ TESTCASE(t_erl_iolist_to_string) } } - + /*********************************************************************** * * 5. M i s c e l l a n o u s T e s t s diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 4f8d45dc8d..4b42f64609 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -387,7 +387,7 @@ merge(F, D1, D2) -> update(K, fun (V1) -> F(K, V1, V2) end, V2, D) end, D1, D2). - + %% get_slot(Hashdb, Key) -> Slot. %% Get the slot. First hash on the new range, if we hit a bucket %% which has not been split use the unsplit buddy bucket. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 73b8da335a..ca6a4b5c58 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -912,7 +912,7 @@ type_test(binary) -> is_binary; type_test(record) -> is_record; type_test(Test) -> Test. - + %% match(Pattern, Term, Bindings) -> %% {match,NewBindings} | nomatch %% or erlang:error({illegal_pattern, Pattern}). @@ -1051,7 +1051,7 @@ match_list([], [], Bs, _BBs) -> {match,Bs}; match_list(_, _, _Bs, _BBs) -> nomatch. - + %% new_bindings() %% bindings(Bindings) %% binding(Name, Bindings) diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 4b654833ed..40ef6c8998 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -222,7 +222,7 @@ format_error(Atom) when is_atom(Atom) -> format_error(Term) -> lists:flatten(io_lib:format("~tp", [Term])). - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Useful definitions (also start of implementation). @@ -412,7 +412,7 @@ split_filename([Comp|Rest], Prefix, Suffix, Len) -> split_filename([], Prefix, Suffix, _) -> {filename:join(Prefix),filename:join(Suffix)}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Retrieving files from a tape archive. diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 9ef4954194..b8c0576e56 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -248,7 +248,7 @@ ensure_dir(F) -> end end. - + %%% %%% Pattern matching using a compiled wildcard. %%% @@ -360,7 +360,7 @@ do_alt([], _File) -> do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). - + %%% Compiling a wildcard. %% Only for debugging. diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 92a086b077..9e69601770 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -583,7 +583,7 @@ printable_unicode_list(_) -> false. %Everything else is false nl() -> "\n". - + %% %% Utilities for collecting characters in input files %% diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index b5577165f4..d6a9f4645d 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -630,7 +630,7 @@ flatlength([H|T], L) when is_list(H) -> flatlength([_|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) Now a BIF! %% keyfind(Key, Index, [Tuple]) A BIF! %% keysearch(Key, Index, [Tuple]) Now a BIF! @@ -1163,7 +1163,7 @@ rumerge(T1, []) -> T1; rumerge(T1, [H2 | T2]) -> lists:reverse(rumerge2_1(T1, T2, [], H2), []). - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 4ed27ff4eb..d0bd0cb26e 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -257,7 +257,7 @@ chars(C, N, Tail) when N > 0 -> chars(C, N-1, [C|Tail]); chars(C, 0, Tail) when is_integer(C) -> Tail. - + %% Torbjörn's bit. %%% COPIES %%% @@ -461,7 +461,7 @@ sub_string(String, Start) -> substr(String, Start). Stop :: pos_integer(). sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1). - + %% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored %% diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl index 37fc694083..1d6a3ac90d 100644 --- a/lib/stdlib/test/slave_SUITE.erl +++ b/lib/stdlib/test/slave_SUITE.erl @@ -230,7 +230,7 @@ rsh_test(ResultTo) -> link(ResultTo), ?line {error, no_rsh} = slave:start(super, slave3). - + %%% Utilities. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 8e71c69d35..189a71a8ce 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -622,7 +622,7 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - + %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. %% (This are here for backwards compatibility.) diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index e1dc86621e..76e0575e68 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -52,7 +52,7 @@ ;; ;; To set the variable you can use the following command: ;; M-x set-variable RET debug-on-error RET t RET - + ;;; Code: ;; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 624042204c..b8699a616d 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1025,7 +1025,7 @@ behaviour.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") - + (defvar erlang-skel-file "erlang-skels" "The type of erlang-skeletons that should be used, default @@ -1272,7 +1272,7 @@ Unfortunately, XEmacs hasn't got support for a special Font Lock syntax table. The effect is that `apply' in the atom `foo_apply' will be highlighted as a bif.") - + ;;; Avoid errors while compiling this file. ;; `eval-when-compile' is not defined in Emacs 18. We define it as a @@ -1321,7 +1321,7 @@ Lock syntax table. The effect is that `apply' in the atom (require 'tempo) (require 'compile)))) - + (defun erlang-version () "Return the current version of Erlang mode." (interactive) @@ -1516,7 +1516,7 @@ Other commands: (set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'add-log-current-defun-function) 'erlang-current-defun)) - + (defun erlang-font-lock-init () "Initialize Font Lock for Erlang mode." (or erlang-font-lock-syntax-table @@ -1686,7 +1686,7 @@ plus variables, macros and records." (font-lock-mode 1) (funcall (symbol-function 'font-lock-fontify-buffer))) - + (defun erlang-menu-init () "Init menus for Erlang mode. @@ -1905,7 +1905,7 @@ Example: The new menu is returned. No guarantee is given that the original menu is left unchanged." (delq entry items)) - + ;; Man code: (defun erlang-man-init () @@ -2228,7 +2228,7 @@ For example: After installing the line, kill and restart Emacs, or restart Erlang mode with the command `M-x erlang-mode RET'."))) - + ;; Skeleton code: ;; This code is based on the package `tempo' which is part of modern @@ -2349,7 +2349,7 @@ The first character of DD is space if the value is less than 10." (erlang-string-to-int (substring date 8 10)) (substring date 4 7) (substring date -4)))) - + ;; Indentation code: (defun erlang-indent-command (&optional whole-exp) @@ -3132,7 +3132,7 @@ commands." (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) - + ;;; Erlang movement commands ;; All commands below work as movement commands. I.e. if the point is @@ -3336,7 +3336,7 @@ With negative argument go towards the beginning of the buffer." (forward-sexp 1) (buffer-substring start (point))))) - + ;;; Miscellaneous (defun erlang-fill-paragraph (&optional justify) @@ -3445,7 +3445,7 @@ at the end." (error "Can't clone argument list")) (insert args) (set-mark p))) - + ;;; Information retrieval functions. (defun erlang-buffer-substring (beg end) @@ -3772,7 +3772,7 @@ exported function." (store-match-data old-match-data) (member (cons name arity) exports)))) - + ;;; Check module name ;; The function `write-file', bound to C-x C-w, calls @@ -3835,7 +3835,7 @@ This function is normally placed in the hook `local-write-file-hooks'." ;; Must return nil since it is added to `local-write-file-hook'. nil) - + ;;; Electric functions. (defun erlang-electric-semicolon (&optional arg) @@ -4229,7 +4229,7 @@ This function is designed to be a member of a criteria list." (erlang-skip-blank) (looking-at "end[^_a-zA-Z0-9]"))) - + ;; Erlang tags support which is aware of erlang modules. ;; ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags @@ -4539,7 +4539,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (or default (error "There is no default tag")) spec))))) - + ;; Search tag functions which are aware of Erlang modules. The tactic ;; is to store new search functions into the local variables of the ;; TAGS buffers. The variables are restored directly after the @@ -4715,7 +4715,7 @@ for a tag on the form `module:tag'." (string= mod (erlang-get-module-from-file-name (file-of-tag))))))) - + ;;; Tags completion, Emacs 19 `etags' specific. ;;; ;;; The basic idea is to create a second completion table `erlang-tags- @@ -4834,7 +4834,7 @@ about Erlang modules." ;; Only the first one will be stored in the table. (intern (concat module ":") table)))))) table)) - + ;;; ;;; Prepare for other methods to run an Erlang slave process. ;;; @@ -4916,7 +4916,7 @@ future, a new shell on an already running host will be started." (call-interactively erlang-next-error-function)) - + ;;; ;;; Erlang Shell Mode -- Major mode used for Erlang shells. ;;; @@ -5052,7 +5052,7 @@ Selects Comint or Compilation mode command as appropriate." (define-key map "\M-\C-m" 'compile-goto-error) (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error))) - + ;;; ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. ;;; diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl index 1c72ef8db5..e3cc51cdb2 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -292,7 +292,7 @@ word_char(C) when C >= $0, C =< $9 -> true; word_char($_) -> true; word_char(_) -> false. - + %%% Output routines %% Check the options `outfile' and `outdir'. @@ -323,7 +323,7 @@ genout(Os, Name, Entries) -> io:put_chars(Os, lists:reverse(Entries)). - + %%% help routines %% Flatten and reverse a nested list. diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 520c5f3dd1..5f2a21aa60 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -146,7 +146,7 @@ format_error({'EXIT', {Code, {Mod, Func, Args}}}) -> [{Code, {Mod, Func, length(Args)}}])); format_error(A) -> atom_to_list(A). - + %%% Parsing commands. @@ -327,7 +327,7 @@ when 0 =< Num1, Num1 =< Num2, Num2 =< State#state.lines -> check_lines(_, _, _, _) -> error(bad_linenum). - + %%% Executing commands. %% ($)= - print line number @@ -657,7 +657,7 @@ undo_command(_, _, _) -> write_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). - + %%% Primitive buffer operations. print_current(St) -> @@ -717,7 +717,7 @@ wrap_next_line(State) when State#state.dot == State#state.lines -> wrap_next_line(State) -> next_line(State). - + %%% Utilities. get_pattern(End, Cmd, State) -> diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 0c53e6f34a..9303bdb125 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -593,7 +593,7 @@ sub_first_match(S, {regexp,RE}) -> nomatch -> nomatch end. - + %% This is the regular expression grammar used. It is equivalent to the %% one used in AWK, except that we allow ^ $ to be used anywhere and fail %% in the matching. @@ -961,7 +961,7 @@ re_apply_or(never_match, R2) -> R2; re_apply_or(R1, never_match) -> R1; re_apply_or(nomatch, R2) -> R2; re_apply_or(R1, nomatch) -> R1. - + %% Record definitions for the NFA, DFA and compiler. -record(nfa_state, {no,edges=[],accept=no}). @@ -1026,7 +1026,7 @@ parse_reas([{RegExp,A}|REAs], S) -> {error,E} -> {error,E} end; parse_reas([], Stack) -> {ok,reverse(Stack)}. - + %% build_combined_nfa(RegExpActionList) -> {NFA,StartState}. %% Build the combined NFA using Thompson's construction straight out %% of the book. Build the separate NFAs in the same order as the @@ -1147,7 +1147,7 @@ nfa_comp_class(Cc) -> comp_crs([{C1,C2}|Crs], Last) -> [{Last,C1-1}|comp_crs(Crs, C2+1)]; comp_crs([], Last) -> [{Last,maxchar}]. - + %% build_dfa(NFA, NfaStartState) -> {DFA,DfaStartState}. %% Build a DFA from an NFA using "subset construction". The major %% difference from the book is that we keep the marked and unmarked @@ -1282,7 +1282,7 @@ accept([St|Sts], NFA) -> #nfa_state{accept=no} -> accept(Sts, NFA) end; accept([], _NFA) -> no. - + %% minimise_dfa(DFA, StartState, FirstState) -> {DFA,StartState}. %% Minimise the DFA by removing equivalent states. We consider a %% state if both the transitions and the their accept state is the @@ -1331,7 +1331,7 @@ pack_dfa([D|DFA], NewN, Rs, PDFA) -> pack_dfa(DFA, NewN+1, [{D#dfa_state.no,NewN}|Rs], [D#dfa_state{no=NewN}|PDFA]); pack_dfa([], _NewN, Rs, PDFA) -> {PDFA,Rs}. - + %% comp_apply(String, StartPos, DFAReg) -> {match,RestPos,Rest} | nomatch. %% Apply the DFA of a regular expression to a string. If %% there is a match return the position of the remaining string and diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl index 1e2b8c86af..73d131ec0b 100644 --- a/system/doc/top/src/erl_html_tools.erl +++ b/system/doc/top/src/erl_html_tools.erl @@ -655,7 +655,7 @@ sub_repl([[{St, L}] |Ss], Fun, Acc0, S, Pos) -> {string:substr(S, Pos+1, St-Pos) ++ Rep ++ Rs, NewAcc}; sub_repl([], _Fun, Acc, S, Pos) -> {string:substr(S, Pos+1), Acc}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Error and warnings -- cgit v1.2.3 From da90582b7188595eabbea3766cee3aebf7cc3cdc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 13 Sep 2013 11:17:54 +0200 Subject: orber: Remove testing of old ssl --- lib/orber/test/multi_ORB_SUITE.erl | 47 +--------------- lib/orber/test/orber_nat_SUITE.erl | 107 +------------------------------------ 2 files changed, 2 insertions(+), 152 deletions(-) diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 3c1ffd59d3..41a309ff16 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -75,8 +75,6 @@ close_connections_local_interface_ctx_override_api/1, ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1, ssl_reconfigure_generation_3_api/1, - ssl_1_multi_orber_generation_3_api_old/1, ssl_2_multi_orber_generation_3_api_old/1, - ssl_reconfigure_generation_3_api_old/1, close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]). @@ -137,13 +135,10 @@ cases() -> setup_multi_connection_timeout_attempts_api, setup_multi_connection_timeout_random_api, ssl_1_multi_orber_api, - ssl_1_multi_orber_generation_3_api_old, ssl_1_multi_orber_generation_3_api, ssl_2_multi_orber_api, - ssl_2_multi_orber_generation_3_api_old, ssl_2_multi_orber_generation_3_api, ssl_reconfigure_api, - ssl_reconfigure_generation_3_api_old, ssl_reconfigure_generation_3_api]. %%----------------------------------------------------------------- @@ -155,10 +150,7 @@ init_per_testcase(TC,Config) TC =:= ssl_reconfigure_api -> init_ssl(Config); init_per_testcase(TC,Config) - when TC =:= ssl_1_multi_orber_generation_3_api_old; - TC =:= ssl_2_multi_orber_generation_3_api_old; - TC =:= ssl_reconfigure_generation_3_api_old; - TC =:= ssl_1_multi_orber_generation_3_api; + when TC =:= ssl_1_multi_orber_generation_3_api; TC =:= ssl_2_multi_orber_generation_3_api; TC =:= ssl_reconfigure_generation_3_api -> init_ssl_3(Config); @@ -1632,22 +1624,6 @@ ssl_1_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_1_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_1_multi_orber_generation_3_api_old(suite) -> []; -ssl_1_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1681,22 +1657,6 @@ ssl_2_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_2_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_2_multi_orber_generation_3_api_old(suite) -> []; -ssl_2_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1724,11 +1684,6 @@ ssl_reconfigure_api(_Config) -> ssl_reconfigure_old([]). -ssl_reconfigure_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_reconfigure_generation_3_api_old(suite) -> []; ssl_reconfigure_generation_3_api_old(_Config) -> ssl_reconfigure_old([{ssl_generation, 3}]). diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index ee31b162c2..a21bd4d499 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -57,7 +57,6 @@ nat_ip_address_local/1, nat_ip_address_local_local/1, nat_iiop_port/1, nat_iiop_port_local/1, nat_iiop_port_local_local/1, - nat_iiop_ssl_port_old/1, nat_iiop_ssl_port_local_old/1, nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]). @@ -93,8 +92,6 @@ cases() -> nat_iiop_port_local, nat_ip_address_local_local, nat_iiop_port_local_local, - nat_iiop_ssl_port_old, - nat_iiop_ssl_port_local_old, nat_iiop_ssl_port, nat_iiop_ssl_port_local]. @@ -103,9 +100,7 @@ cases() -> %%----------------------------------------------------------------- init_per_testcase(TC, Config) when TC =:= nat_iiop_ssl_port; - TC =:= nat_iiop_ssl_port_local; - TC =:= nat_iiop_ssl_port_old; - TC =:= nat_iiop_ssl_port_local_old -> + TC =:= nat_iiop_ssl_port_local -> case ?config(crypto_started, Config) of true -> case orber_test_lib:ssl_version() of @@ -291,106 +286,6 @@ nat_iiop_port_local_local(_Config) -> %% API tests for ORB to ORB, ssl security depth 1 %%----------------------------------------------------------------- -nat_iiop_ssl_port_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_old(suite) -> []; -nat_iiop_ssl_port_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, ?ORB_ENV_ENABLE_NAT}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{4001, 43}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - -nat_iiop_ssl_port_local_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_local_old(suite) -> []; -nat_iiop_ssl_port_local_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, - (?ORB_ENV_LOCAL_INTERFACE bor - ?ORB_ENV_ENABLE_NAT)}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "Make sure NAT works for SSL"]; -- cgit v1.2.3 From 6189bc07f44a0dbb68dbc65689e049decc0d52e7 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Wed, 11 Sep 2013 12:04:36 +0200 Subject: inets: httpc improve pipelining --- lib/inets/src/http_client/httpc_handler.erl | 44 +++++++------------------ lib/inets/src/http_client/httpc_internal.hrl | 6 ++-- lib/inets/src/http_client/httpc_manager.erl | 48 ++++++++++++++++++---------- lib/inets/test/httpc_SUITE.erl | 6 ---- 4 files changed, 46 insertions(+), 58 deletions(-) diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 55794f57dc..f84f37c746 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1165,7 +1165,7 @@ handle_http_body(Body, #state{headers = Headers, handle_response(#state{status = new} = State) -> ?hcrd("handle response - status = new", []), - handle_response(try_to_enable_pipeline_or_keep_alive(State)); + handle_response(check_persistent(State)); handle_response(#state{request = Request, status = Status, @@ -1440,39 +1440,22 @@ is_keep_alive_enabled_server(_,_) -> is_keep_alive_connection(Headers, #session{client_close = ClientClose}) -> (not ((ClientClose) orelse httpc_response:is_server_closing(Headers))). -try_to_enable_pipeline_or_keep_alive( - #state{session = Session, - request = #request{method = Method}, +check_persistent( + #state{session = #session{type = Type} = Session, status_line = {Version, _, _}, headers = Headers, - profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), + profile_name = ProfileName} = State) -> case is_keep_alive_enabled_server(Version, Headers) andalso - is_keep_alive_connection(Headers, Session) of + is_keep_alive_connection(Headers, Session) of true -> - case (is_pipeline_enabled_client(Session) andalso - httpc_request:is_idempotent(Method)) of - true -> - insert_session(Session, ProfileName), - State#state{status = pipeline}; - false -> - insert_session(Session, ProfileName), - %% Make sure type is keep_alive in session - %% as it in this case might be pipeline - NewSession = Session#session{type = keep_alive}, - State#state{status = keep_alive, - session = NewSession} - end; + mark_persistent(ProfileName, Session), + State#state{status = Type}; false -> State#state{status = close} end. answer_request(#request{id = RequestId, from = From} = Request, Msg, - #state{session = Session, - timers = Timers, + #state{timers = Timers, profile_name = ProfileName} = State) -> ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), @@ -1482,19 +1465,14 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, Timer = {RequestId, TimerRef}, cancel_timer(TimerRef, {timeout, Request#request.id}), httpc_manager:request_done(RequestId, ProfileName), - NewSession = maybe_make_session_available(ProfileName, Session), Timers2 = Timers#timers{request_timers = lists:delete(Timer, RequestTimers)}, State#state{request = Request#request{from = answer_sent}, - session = NewSession, timers = Timers2}. -maybe_make_session_available(ProfileName, - #session{available = false} = Session) -> - update_session(ProfileName, Session, #session.available, true), - Session#session{available = true}; -maybe_make_session_available(_ProfileName, Session) -> - Session. +mark_persistent(ProfileName, Session) -> + update_session(ProfileName, Session, #session.persistent, true), + Session#session{persistent = true}. cancel_timers(#timers{request_timers = ReqTmrs, queue_timer = QTmr}) -> cancel_timer(QTmr, timeout_queue), diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 30e2742e9d..d5b3dd2a2a 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -143,8 +143,8 @@ %% true | false %% This will be true, when a response has been received for - %% the first request. See type above. - available = false + %% the first request and the server has not closed the connection + persistent = false }). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index c45dcab802..3cd225abb3 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -467,7 +467,7 @@ do_init(ProfileName, CookiesDir) -> %%-------------------------------------------------------------------- handle_call({request, Request}, _, State) -> ?hcri("request", [{request, Request}]), - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, false)) of {reply, Msg, NewState} -> {reply, Msg, NewState}; Error -> @@ -547,7 +547,7 @@ handle_cast({retry_or_redirect_request, {Time, Request}}, {noreply, State}; handle_cast({retry_or_redirect_request, Request}, State) -> - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, true)) of {reply, {ok, _}, NewState} -> {noreply, NewState}; Error -> @@ -774,7 +774,7 @@ get_handler_info(Tab) -> handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/0.9 client that does not know anything %% about persistent connections @@ -787,7 +787,7 @@ handle_request(#request{settings = handle_request(#request{settings = #http_options{version = "HTTP/1.0"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/1.0 client that does not %% use persistent connections @@ -798,13 +798,13 @@ handle_request(#request{settings = start_handler(NewRequest#request{headers = NewHeaders}, State), {reply, {ok, NewRequest#request.id}, State}; -handle_request(Request, State = #state{options = Options}) -> +handle_request(Request, State = #state{options = Options}, Retry) -> NewRequest = handle_cookies(generate_request_id(Request), State), SessionType = session_type(Options), case select_session(Request#request.method, Request#request.address, - Request#request.scheme, SessionType, State) of + Request#request.scheme, SessionType, State, Retry) of {ok, HandlerPid} -> pipeline_or_keep_alive(NewRequest, HandlerPid, State); no_connection -> @@ -828,6 +828,7 @@ start_handler(#request{id = Id, #state{profile_name = ProfileName, handler_db = HandlerDb, options = Options}) -> + ClientClose = httpc_request:is_client_closing(Request#request.headers), {ok, Pid} = case is_inets_manager() of true -> @@ -838,13 +839,18 @@ start_handler(#request{id = Id, end, HandlerInfo = {Id, Pid, From}, ets:insert(HandlerDb, HandlerInfo), + insert_session(#session{id = {Request#request.address, Pid}, + scheme = Request#request.scheme, + client_close = ClientClose, + type = session_type(Options) + }, ProfileName), erlang:monitor(process, Pid). select_session(Method, HostPort, Scheme, SessionType, #state{options = #options{max_pipeline_length = MaxPipe, max_keep_alive_length = MaxKeepAlive}, - session_db = SessionDb}) -> + session_db = SessionDb}, Retry) -> ?hcrd("select session", [{session_type, SessionType}, {max_pipeline_length, MaxPipe}, {max_keep_alive_length, MaxKeepAlive}]), @@ -857,19 +863,29 @@ select_session(Method, HostPort, Scheme, SessionType, %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length %% specified. - Pattern = #session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - queue_length = '$2', - type = SessionType, - available = true, - _ = '_'}, + Pattern = case (Retry andalso SessionType == pipeline) of + true -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + persistent = true, + _ = '_'}; + false -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + _ = '_'} + end, %% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp}, Candidates = ets:match(SessionDb, Pattern), ?hcrd("select session", [{host_port, HostPort}, {scheme, Scheme}, {type, SessionType}, - {candidates, Candidates}]), + {candidates, Candidates}]), select_session(Candidates, MaxKeepAlive, MaxPipe, SessionType); false -> no_connection diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0c35f284f7..e075de2517 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -277,9 +277,6 @@ trace(Config) when is_list(Config) -> pipeline(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], pipeline), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, pipeline). %%-------------------------------------------------------------------- @@ -287,9 +284,6 @@ pipeline(Config) when is_list(Config) -> persistent_connection(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], persistent), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- -- cgit v1.2.3 From 89f541f6f9d4b90155c2a3b5e81194327810f693 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Wed, 11 Sep 2013 15:58:51 +0200 Subject: httpc: Enhanched error handling --- lib/inets/src/http_client/httpc_handler.erl | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index f84f37c746..6f45e82eda 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -521,19 +521,12 @@ handle_info({Proto, _Socket, Data}, activate_once(Session), {noreply, State#state{mfa = NewMFA}} catch - exit:_Exit -> - ?hcrd("data processing exit", [{exit, _Exit}]), + _:_Reason -> + ?hcrd("data processing exit", [{exit, _Reason}]), ClientReason = {could_not_parse_as_http, Data}, ClientErrMsg = httpc_response:error(Request, ClientReason), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - error:_Error -> - ?hcrd("data processing error", [{error, _Error}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState} - end, ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; -- cgit v1.2.3 From 7d8397a7c9abdee42a1da57ba6b1bbc4b9f6a5c3 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Wed, 11 Sep 2013 15:56:31 +0200 Subject: inets: httpc make httpc_cancel_request/[1,2] asynchronous --- lib/inets/doc/src/httpc.xml | 7 ++- lib/inets/src/http_client/httpc.erl | 12 +---- lib/inets/src/http_client/httpc_handler.erl | 14 ++--- lib/inets/src/http_client/httpc_manager.erl | 80 ++++++----------------------- lib/inets/test/httpc_SUITE.erl | 11 ++-- 5 files changed, 30 insertions(+), 94 deletions(-) diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index d9a27e7d1e..db68cc3116 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -4,7 +4,7 @@
- 20042012 + 20042013 Ericsson AB. All Rights Reserved. @@ -440,7 +440,10 @@ apply(Module, Function, [ReplyInfo | Args]) Profile = profile() | pid() (when started stand_alone) -

Cancels an asynchronous HTTP-request.

+

Cancels an asynchronous HTTP-request. Note this does not guarantee + that the request response will not be delivered, as it is asynchronous the + the request may already have been completed when the cancellation arrives. +

diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 4d7023a8e9..151539f52f 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -208,16 +208,8 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), - ok = httpc_manager:cancel_request(RequestId, profile_name(Profile)), - receive - %% If the request was already fulfilled throw away the - %% answer as the request has been canceled. - {http, {RequestId, _}} -> - ok - after 0 -> - ok - end. - + httpc_manager:cancel_request(RequestId, profile_name(Profile)). + %%-------------------------------------------------------------------------- %% set_options(Options) -> ok | {error, Reason} diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 6f45e82eda..80c8b2439e 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,7 @@ start_link/4, %% connect_and_send/2, send/2, - cancel/3, + cancel/2, stream_next/1, info/1 ]). @@ -117,8 +117,8 @@ send(Request, Pid) -> %% Description: Cancels a request. Intended to be called by the httpc %% manager process. %%-------------------------------------------------------------------- -cancel(RequestId, Pid, From) -> - cast({cancel, RequestId, From}, Pid). +cancel(RequestId, Pid) -> + cast({cancel, RequestId}, Pid). %%-------------------------------------------------------------------- @@ -400,19 +400,17 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, profile_name = ProfileName, canceled = Canceled} = State) -> ?hcrv("cancel current request", [{request_id, RequestId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{profile_name = ProfileName, request = #request{id = CurrId}, canceled = Canceled} = State) -> @@ -420,8 +418,6 @@ handle_cast({cancel, RequestId, From}, {curr_req_id, CurrId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {noreply, State#state{canceled = [RequestId | Canceled]}}; handle_cast(stream_next, #state{session = Session} = State) -> diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 3cd225abb3..a3ed371e61 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -29,7 +29,6 @@ start_link/3, request/2, cancel_request/2, - request_canceled/3, request_done/2, retry_request/2, redirect_request/2, @@ -144,22 +143,7 @@ redirect_request(Request, ProfileName) -> %%-------------------------------------------------------------------- cancel_request(RequestId, ProfileName) -> - call(ProfileName, {cancel_request, RequestId}). - - -%%-------------------------------------------------------------------- -%% Function: request_canceled(RequestId, ProfileName) -> ok -%% RequestId - ref() -%% ProfileName = atom() -%% -%% Description: Confirms that a request has been canceld. Intended to -%% be called by the httpc handler process. -%%-------------------------------------------------------------------- - -request_canceled(RequestId, ProfileName, From) -> - gen_server:reply(From, ok), - cast(ProfileName, {request_canceled, RequestId}). - + cast(ProfileName, {cancel_request, RequestId}). %%-------------------------------------------------------------------- %% Function: request_done(RequestId, ProfileName) -> ok @@ -474,26 +458,6 @@ handle_call({request, Request}, _, State) -> {stop, Error, httpc_response:error(Request, Error), State} end; -handle_call({cancel_request, RequestId}, From, - #state{handler_db = HandlerDb} = State) -> - ?hcri("cancel_request", [{request_id, RequestId}]), - case ets:lookup(HandlerDb, RequestId) of - [] -> - %% The request has allready compleated make sure - %% it is deliverd to the client process queue so - %% it can be thrown away by httpc:cancel_request - %% This delay is hopfully a temporary workaround. - %% Note that it will not not delay the manager, - %% only the client that called httpc:cancel_request - timer:apply_after(?DELAY, gen_server, reply, [From, ok]), - {noreply, State}; - [{_, Pid, _}] -> - httpc_handler:cancel(RequestId, Pid, From), - {noreply, - State#state{cancel = - [{RequestId, Pid, From} | State#state.cancel]}} - end; - handle_call(reset_cookies, _, #state{cookie_db = CookieDb} = State) -> ?hcrv("reset cookies", []), httpc_cookie:reset_db(CookieDb), @@ -555,19 +519,19 @@ handle_cast({retry_or_redirect_request, Request}, State) -> {stop, Error, State} end; -handle_cast({request_canceled, RequestId}, State) -> - ?hcrv("request canceled", [{request_id, RequestId}]), - ets:delete(State#state.handler_db, RequestId), - case lists:keysearch(RequestId, 1, State#state.cancel) of - {value, Entry = {RequestId, _, From}} -> - ?hcrt("found in cancel", [{from, From}]), - {noreply, - State#state{cancel = lists:delete(Entry, State#state.cancel)}}; - Else -> - ?hcrt("not found in cancel", [{else, Else}]), - {noreply, State} +handle_cast({cancel_request, RequestId}, + #state{handler_db = HandlerDb} = State) -> + case ets:lookup(HandlerDb, RequestId) of + [] -> + %% Request already compleated nothing to + %% cancel + {noreply, State}; + [{_, Pid, _}] -> + httpc_handler:cancel(RequestId, Pid), + ets:delete(State#state.handler_db, RequestId), + {noreply, State} end; - + handle_cast({request_done, RequestId}, State) -> ?hcrv("request done", [{request_id, RequestId}]), ets:delete(State#state.handler_db, RequestId), @@ -629,22 +593,8 @@ handle_info({'EXIT', _, _}, State) -> %% Handled in DOWN {noreply, State}; handle_info({'DOWN', _, _, Pid, _}, State) -> - ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), - - %% If there where any canceled request, handled by the - %% the process that now has terminated, the - %% cancelation can be viewed as sucessfull! - NewCanceldList = - lists:foldl(fun(Entry = {_, HandlerPid, From}, Acc) -> - case HandlerPid of - Pid -> - gen_server:reply(From, ok), - lists:delete(Entry, Acc); - _ -> - Acc - end - end, State#state.cancel, State#state.cancel), - {noreply, State#state{cancel = NewCanceldList}}; + ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), + {noreply, State}; handle_info(Info, State) -> Report = io_lib:format("Unknown message in " "httpc_manager:handle_info ~p~n", [Info]), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index e075de2517..818edc12ac 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -305,13 +305,8 @@ async(Config) when is_list(Config) -> {ok, NewRequestId} = httpc:request(get, Request, [], [{sync, false}]), - ok = httpc:cancel_request(NewRequestId), - receive - {http, {NewRequestId, _}} -> - ct:fail(http_cancel_request_failed) - after 3000 -> - ok - end. + ok = httpc:cancel_request(NewRequestId). + %%------------------------------------------------------------------------- save_to_file() -> [{doc, "Test to save the http body to a file"}]. @@ -1143,7 +1138,7 @@ receive_replys([ID|IDs]) -> {http, {ID, {{_, 200, _}, [_|_], _}}} -> receive_replys(IDs); {http, {Other, {{_, 200, _}, [_|_], _}}} -> - ct:fail({recived_canceld_id, Other}) + ct:pal({recived_canceld_id, Other}) end. %% Perform a synchronous stop -- cgit v1.2.3 From b732d1df54c9567cf15015bf549b812252299d9f Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Mon, 16 Sep 2013 11:05:56 +0200 Subject: The gen_event callback module expects terminate/2, not terminate/1 --- lib/common_test/src/cth_log_redirect.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index 4ee7e48a67..b7f0e1fd7f 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -34,7 +34,7 @@ %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/1]). + terminate/2]). %% Other -export([handle_remote_events/1]). @@ -184,7 +184,7 @@ handle_call({handle_remote_events,Bool}, State) -> handle_call(_Query, _State) -> {error, bad_query}. -terminate(_State) -> +terminate(_Arg, _State) -> error_logger:delete_report_handler(?MODULE), []. -- cgit v1.2.3 From 935874338ca9946997410a4276bf6c85847e10da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johannes=20Wei=C3=9Fl?= Date: Thu, 5 Sep 2013 09:26:55 +0200 Subject: Add test for httpd config option 'script_timeout' The option got ignored before 720721e. --- lib/inets/test/httpd_basic_SUITE.erl | 66 ++++++++++++++++++---- lib/inets/test/httpd_basic_SUITE_data/Makefile.src | 14 +++++ lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c | 26 +++++++++ 3 files changed, 94 insertions(+), 12 deletions(-) create mode 100644 lib/inets/test/httpd_basic_SUITE_data/Makefile.src create mode 100644 lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index b1fe373cff..f164a2eda7 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -38,6 +38,7 @@ all() -> erl_script_nocache_opt, script_nocache, escaped_url_in_error_body, + script_timeout, slowdose ]. @@ -80,16 +81,19 @@ DUMMY DummyFile = filename:join([PrivDir,"dummy.html"]), CgiDir = filename:join(PrivDir, "cgi-bin"), ok = file:make_dir(CgiDir), - Cgi = case test_server:os_type() of - {win32, _} -> - "printenv.bat"; - _ -> - "printenv.sh" - end, - inets_test_lib:copy_file(Cgi, DataDir, CgiDir), - AbsCgi = filename:join([CgiDir, Cgi]), - {ok, FileInfo} = file:read_file_info(AbsCgi), - ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}), + {CgiPrintEnv, CgiSleep} = case test_server:os_type() of + {win32, _} -> + {"printenv.bat", "cgi_sleep.exe"}; + _ -> + {"printenv.sh", "cgi_sleep"} + end, + lists:foreach( + fun(Cgi) -> + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}) + end, [CgiPrintEnv, CgiSleep]), {ok, Fd} = file:open(DummyFile, [write]), ok = file:write(Fd, Dummy), ok = file:close(Fd), @@ -100,7 +104,8 @@ DUMMY {document_root, PrivDir}, {bind_address, "localhost"}], - [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, {cgi_script, Cgi} | Config]. + [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, + {cgi_printenv, CgiPrintEnv}, {cgi_sleep, CgiSleep} | Config]. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ @@ -235,7 +240,7 @@ script_nocache(Config) when is_list(Config) -> verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> HttpdConf = ?config(httpd_conf, Config), - CgiScript = ?config(cgi_script, Config), + CgiScript = ?config(cgi_printenv, Config), CgiDir = ?config(cgi_dir, Config), {ok, Pid} = inets:start(httpd, [{port, 0}, {script_alias, @@ -363,6 +368,43 @@ escaped_url_in_error_body(Config) when is_list(Config) -> inets:stop(httpd, Pid), tsp("escaped_url_in_error_body -> done"), ok. + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + +script_timeout(doc) -> + ["Test the httpd script_timeout option"]; +script_timeout(suite) -> + []; +script_timeout(Config) when is_list(Config) -> + verify_script_timeout(Config, 20, 200), + verify_script_timeout(Config, 5, 403), + ok. + +verify_script_timeout(Config, ScriptTimeout, StatusCode) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_sleep, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_timeout, ScriptTimeout} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, StatusCode}, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + slowdose(doc) -> ["Testing minimum bytes per second option"]; slowdose(Config) when is_list(Config) -> diff --git a/lib/inets/test/httpd_basic_SUITE_data/Makefile.src b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src new file mode 100644 index 0000000000..9da2ed583f --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cgi_sleep@exe@ + +all: $(PROGS) + +cgi_sleep@exe@: cgi_sleep@obj@ + $(LD) $(CROSSLDFLAGS) -o cgi_sleep cgi_sleep@obj@ @LIBS@ + +cgi_sleep@obj@: cgi_sleep.c + $(CC) -c -o cgi_sleep@obj@ $(CFLAGS) cgi_sleep.c diff --git a/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c new file mode 100644 index 0000000000..126bb23987 --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c @@ -0,0 +1,26 @@ +#include +#include + +#ifdef __WIN32__ +#include +#include +#include +#else +#include +#endif + +int main(void) +{ + unsigned int seconds = 10; + +#ifdef __WIN32__ + Sleep(seconds * 1000); + _setmode(_fileno(stdout), _O_BINARY); +#else + sleep(seconds); +#endif + + printf("Content-type: text/plain\r\n\r\n"); + printf("Slept for %u seconds.\r\n", seconds); + exit(EXIT_SUCCESS); +} -- cgit v1.2.3 From c666e8c99ad0974cd6fce047b8b1f9c9aacd4c19 Mon Sep 17 00:00:00 2001 From: Yuki Ito Date: Sat, 21 Sep 2013 19:37:27 +0900 Subject: Fix I/O-protocol error handling in eunit A io_request in eunit reuturns wrong value when it receive getopts or get_geometry request. --- lib/eunit/src/eunit_proc.erl | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index ec7d93fd48..03d1a18321 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -643,11 +643,11 @@ io_request({get_until, _Prompt, _M, _F, _As}, Buf) -> io_request({setopts, _Opts}, Buf) -> {ok, Buf}; io_request(getopts, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,columns}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,rows}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({requests, Reqs}, Buf) -> io_requests(Reqs, {ok, Buf}); io_request(_, Buf) -> @@ -657,3 +657,10 @@ io_requests([R | Rs], {ok, Buf}) -> io_requests(Rs, io_request(R, Buf)); io_requests(_, Result) -> Result. + +-ifdef(TEST). +io_error_test_() -> + [?_assertMatch({error, enotsup}, io:getopts()), + ?_assertMatch({error, enotsup}, io:columns()), + ?_assertMatch({error, enotsup}, io:rows())]. +-endif. -- cgit v1.2.3 From b404991ffb133e7deb4f9f85816841d5f4a33240 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Sat, 21 Sep 2013 12:39:00 +0200 Subject: Fix two small silent rules omissions --- erts/etc/unix/Makefile | 2 +- lib/ic/c_src/Makefile.in | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/erts/etc/unix/Makefile b/erts/etc/unix/Makefile index e85d2fab0c..c137a31ec2 100644 --- a/erts/etc/unix/Makefile +++ b/erts/etc/unix/Makefile @@ -29,7 +29,7 @@ opt debug: etc etc: etp-commands etp-commands: etp-commands.in - sed 's:@ERL_TOP@:${ERL_TOP}:g' etp-commands.in > etp-commands + $(gen_verbose)sed 's:@ERL_TOP@:${ERL_TOP}:g' etp-commands.in > etp-commands .PHONY: docs docs: diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in index 6e65f06114..ed860ab73b 100644 --- a/lib/ic/c_src/Makefile.in +++ b/lib/ic/c_src/Makefile.in @@ -132,10 +132,8 @@ docs: _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) $(LIBRARY): $(OBJ_FILES) - $(ar_verbose) - -$(AR) $(AR_OUT) $@ $(OBJ_FILES) - $(ranlib_verbose) - -$(RANLIB) $@ + -$(V_AR) $(AR_OUT) $@ $(OBJ_FILES) + -$(V_RANLIB) $@ $(OBJDIR)/%.o: %.c $(V_CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $< -- cgit v1.2.3 From cee5e8344470904f98579fae7046f49d65dbcb33 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 24 Sep 2013 16:31:06 +0200 Subject: inets: httpc - Remove dead error handling code Some error handling is only relevant for functions that end up in gen_server:call and not in gen_server:cast. --- lib/inets/src/http_client/httpc.erl | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 151539f52f..da9bbdd1ec 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -233,14 +233,7 @@ set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> - try - begin - httpc_manager:set_options(Opts, profile_name(Profile)) - end - catch - exit:{noproc, _} -> - {error, inets_not_started} - end; + httpc_manager:set_options(Opts, profile_name(Profile)); {error, Reason} -> {error, Reason} end. @@ -335,8 +328,6 @@ store_cookies(SetCookieHeaders, Url, Profile) ok end catch - exit:{noproc, _} -> - {error, {not_started, Profile}}; error:{badmatch, Bad} -> {error, {parse_failed, Bad}} end. -- cgit v1.2.3 From 1a7f7b4abf091f19772f27cfc65eff532c334694 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Wed, 25 Sep 2013 09:51:45 +0200 Subject: eldap: eldap does not support peer verification, removed {verify, 0} from ssl options --- lib/eldap/src/eldap.erl | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index d11f904996..8ebb88e35b 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -42,8 +42,8 @@ log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication - use_tls = false, % LDAP/LDAPS - tls_opts = [] % ssl:ssloptsion() + use_tls = false, % LDAP/LDAPS + tls_opts = [] % ssl:ssloption() }). %%% For debug purposes @@ -389,8 +389,7 @@ try_connect([],_) -> do_connect(Host, Data, Opts) when Data#eldap.use_tls == false -> gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); do_connect(Host, Data, Opts) when Data#eldap.use_tls == true -> - SslOpts = [{verify,0} | Opts ++ Data#eldap.tls_opts], - ssl:connect(Host, Data#eldap.port, SslOpts). + ssl:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tls_opts). loop(Cpid, Data) -> receive -- cgit v1.2.3 From 04e6e90856420df28dbac918de3ec22524a221cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 Sep 2013 16:15:29 +0200 Subject: asn1ct_value: Handle named INTEGERs with constraints The asn1ct:value/2 function would crash for name INTEGERs with constraints, such as INTEGER {a(2),b(3),z(17)} (2|3|17, ...). --- lib/asn1/src/asn1ct_value.erl | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 992210232f..862b3c4ea5 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -167,17 +167,16 @@ from_type_prim(M, D) -> case D#type.def of 'INTEGER' -> i_random(C); - {'INTEGER',NamedNumberList} -> - NN = [X||{X,_} <- NamedNumberList], - case NN of + {'INTEGER',[_|_]=NNL} -> + case C of [] -> - i_random(C); + {N,_} = lists:nth(random(length(NNL)), NNL), + N; _ -> - case C of - [] -> - lists:nth(random(length(NN)),NN); - _ -> - lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN) + V = i_random(C), + case lists:keyfind(V, 2, NNL) of + false -> V; + {N,V} -> N end end; Enum when is_tuple(Enum),element(1,Enum)=='ENUMERATED' -> -- cgit v1.2.3 From c28e62178eced67090d5e5f40d0f6207a6875740 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 16 Sep 2013 14:04:08 +0200 Subject: PER/UPER: Correct encoding for single-value extensible constraints An extensible constraint which is a union of single values, such as: INTEGER (1|17, ...) would be incorrectly encoded. --- lib/asn1/src/asn1ct_imm.erl | 21 ++++++++- lib/asn1/test/asn1_SUITE_data/Constraints.py | 5 +++ lib/asn1/test/testConstraints.erl | 64 +++++++++++++++++++++++++++- 3 files changed, 88 insertions(+), 2 deletions(-) diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 892178f61b..7af7e192c3 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -994,6 +994,25 @@ mk_var(Base, V) -> per_enc_integer_1(Val, [], Aligned) -> [{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}]; +per_enc_integer_1(Val, [{{'SingleValue',[_|_]=Svs}=Constr,[]}], Aligned) -> + %% An extensible constraint such as (1|17, ...). + %% + %% A subtle detail is that the extension root as described in the + %% ASN.1 spec should be used to determine whether a particular value + %% belongs to the extension root (as opposed to the effective + %% constraint, which will be used for the actual encoding). + %% + %% So for the example above, only the integers 1 and 17 should be + %% encoded as root values (extension bit = 0). + + [{'ValueRange',{Lb,Ub}}] = effective_constraint(integer, [Constr]), + Root = [begin + {[],_,Put} = per_enc_constrained(Sv, Lb, Ub, Aligned), + [{eq,Val,Sv},{put_bits,0,1,[1]}|Put] + end || Sv <- Svs], + Cs = Root ++ [['_',{put_bits,1,1,[1]}| + per_enc_unconstrained(Val, Aligned)]], + build_cond(Cs); per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) -> {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action], @@ -1004,7 +1023,7 @@ per_enc_integer_1(Val0, [Constr], Aligned) -> Prefix++build_cond([[Check|Action], ['_',{error,Val0}]]). -per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) -> +per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> per_enc_constrained(Val, Sv, Sv, Aligned); per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned) when is_integer(Lb) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py index e4bc987e4c..581ec2f467 100644 --- a/lib/asn1/test/asn1_SUITE_data/Constraints.py +++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py @@ -17,6 +17,11 @@ NegSemiConstrained ::= INTEGER (-128..MAX) SemiConstrainedExt ::= INTEGER (42..MAX, ...) NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...) +-- Union of single values +Sv1 ::= INTEGER (2|3|17) +Sv2 ::= INTEGER (2|3|17, ...) +Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + -- Other constraints FixedSize ::= OCTET STRING (SIZE(10)) FixedSize2 ::= OCTET STRING (SIZE(10|20)) diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 9a1d62993d..34fbbcf6cc 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -121,6 +121,42 @@ int_constraints(Rules) -> roundtrip('X1', 20), range_error(Rules, 'X1', 21), + %%========================================================== + %% Union of single values + %% Sv1 ::= INTEGER (2|3|17) + %% Sv2 ::= INTEGER (2|3|17, ...) + %% Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + %%========================================================== + + range_error(Rules, 'Sv1', 1), + range_error(Rules, 'Sv1', 18), + roundtrip('Sv1', 2), + roundtrip('Sv1', 3), + roundtrip('Sv1', 7), + + %% Encoded as root + v_roundtrip(Rules, 'Sv2', 2), + v_roundtrip(Rules, 'Sv2', 3), + v_roundtrip(Rules, 'Sv2', 17), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv2', 1), + v_roundtrip(Rules, 'Sv2', 4), + v_roundtrip(Rules, 'Sv2', 18), + + %% Encoded as root + v_roundtrip(Rules, 'Sv3', a), + v_roundtrip(Rules, 'Sv3', b), + v_roundtrip(Rules, 'Sv3', z), + v_roundtrip(Rules, 'Sv3', 2, a), + v_roundtrip(Rules, 'Sv3', 3, b), + v_roundtrip(Rules, 'Sv3', 17, z), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv3', 1), + v_roundtrip(Rules, 'Sv3', 4), + v_roundtrip(Rules, 'Sv3', 18), + %%========================================================== %% SemiConstrained %%========================================================== @@ -197,7 +233,29 @@ v(per, 'SemiConstrainedExt', 42+128) -> "000180"; v(uper, 'SemiConstrainedExt', 42+128) -> "00C000"; v(ber, 'NegSemiConstrainedExt', 0) -> "020100"; v(per, 'NegSemiConstrainedExt', 0) -> "000180"; -v(uper, 'NegSemiConstrainedExt', 0) -> "00C000". +v(uper, 'NegSemiConstrainedExt', 0) -> "00C000"; +v(ber, 'Sv2', 1) -> "020101"; +v(per, 'Sv2', 1) -> "800101"; +v(uper, 'Sv2', 1) -> "808080"; +v(ber, 'Sv2', 2) -> "020102"; +v(per, 'Sv2', 2) -> "00"; +v(uper, 'Sv2', 2) -> "00"; +v(ber, 'Sv2', 3) -> "020103"; +v(per, 'Sv2', 3) -> "08"; +v(uper, 'Sv2', 3) -> "08"; +v(ber, 'Sv2', 4) -> "020104"; +v(per, 'Sv2', 4) -> "800104"; +v(uper, 'Sv2', 4) -> "808200"; +v(ber, 'Sv2', 17) -> "020111"; +v(per, 'Sv2', 17) -> "78"; +v(uper, 'Sv2', 17) -> "78"; +v(ber, 'Sv2', 18) -> "020112"; +v(per, 'Sv2', 18) -> "800112"; +v(uper, 'Sv2', 18) -> "808900"; +v(Rule, 'Sv3', a) -> v(Rule, 'Sv2', 2); +v(Rule, 'Sv3', b) -> v(Rule, 'Sv2', 3); +v(Rule, 'Sv3', z) -> v(Rule, 'Sv2', 17); +v(Rule, 'Sv3', Val) when is_integer(Val) -> v(Rule, 'Sv2', Val). shorter_ext(per, "a") -> <<16#80,16#01,16#61>>; shorter_ext(uper, "a") -> <<16#80,16#E1>>; @@ -211,6 +269,10 @@ v_roundtrip(Erule, Type, Value) -> Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), Encoded = roundtrip('Constraints', Type, Value). +v_roundtrip(Erule, Type, Value, Expected) -> + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), + Encoded = asn1_test_lib:roundtrip_enc('Constraints', Type, Value, Expected). + roundtrip(Type, Value) -> roundtrip('Constraints', Type, Value). -- cgit v1.2.3 From 2f27a8e9c6ab484effd5f7b235be13e98c206cd1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 30 Sep 2013 12:44:17 +0200 Subject: Cope with .erlang files that print to stdout Don't redirect standard output when auto-generating the asn1ct_rtt.erl and asn1ct_eval*.erl source files, because anything printed form .erlang will end up in them, probably causing a compilation error. --- lib/asn1/src/Makefile | 4 +-- lib/asn1/src/prepare_templates.erl | 72 +++++++++++++++++++++----------------- 2 files changed, 42 insertions(+), 34 deletions(-) diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 3f24e15c04..500f4a1358 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -135,7 +135,7 @@ $(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl asn1ct_eval_%.erl: asn1ct_eval_%.funcs $(gen_verbose)erl -pa $(EBIN) -noshell -noinput \ - -run prepare_templates gen_asn1ct_eval $< >$@ + -run prepare_templates gen_asn1ct_eval $< $(APP_TARGET): $(APP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ @@ -180,7 +180,7 @@ RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET) $(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ - $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl + $(RT_TEMPLATES_TARGET) prepare_templates.$(EMULATOR): prepare_templates.erl $(V_ERLC) prepare_templates.erl diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl index 83155b2e52..ccd15548d8 100644 --- a/lib/asn1/src/prepare_templates.erl +++ b/lib/asn1/src/prepare_templates.erl @@ -21,69 +21,77 @@ -export([gen_asn1ct_rtt/1,gen_asn1ct_eval/1]). gen_asn1ct_rtt(Ms) -> - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + {ok,Fd} = file:open("asn1ct_rtt.erl", [write]), + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input files:\n", [?MODULE]), - [io:put_chars(["%% ",M,$\n]) || M <- Ms], - io:nl(), - io:put_chars("-module(asn1ct_rtt).\n" + [io:put_chars(Fd, ["%% ",M,$\n]) || M <- Ms], + io:nl(Fd), + io:put_chars(Fd, + "-module(asn1ct_rtt).\n" "-export([assert_defined/1,dependencies/1,code/0]).\n" "\n"), Forms = lists:sort(lists:append([abstract(M) || M <- Ms])), Exp = lists:sort(exports(Forms)), - defined(Exp), - io:nl(), + defined(Fd, Exp), + io:nl(Fd), Calls = calls(Forms), R = sofs:relation(Calls), Fam0 = sofs:relation_to_family(R), Fam = sofs:to_external(Fam0), - dependencies(Fam), - io:nl(), + dependencies(Fd, Fam), + io:nl(Fd), Funcs = [begin Bin = list_to_binary([$\n|erl_pp:function(Func)]), {{M,F,A},Bin} end || {M,{function,_,F,A,_}=Func} <- Forms], - io:format("code() ->\n~p.\n\n", [Funcs]), + io:format(Fd, "code() ->\n~p.\n\n", [Funcs]), + ok = file:close(Fd), halt(0). gen_asn1ct_eval([File]) -> + Output = filename:rootname(File, ".funcs") ++ ".erl", + {ok,Fd} = file:open(Output, [write]), {ok,Funcs} = file:consult(File), asn1ct_func:start_link(), [asn1ct_func:need(MFA) || MFA <- Funcs], - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input file: ~s\n\n", [?MODULE,File]), - io:format("-module(~s).\n", [filename:rootname(File)]), - gen_asn1ct_eval_exp(Funcs), - asn1ct_func:generate(group_leader()), + io:format(Fd, "-module(~s).\n", [filename:rootname(File)]), + gen_asn1ct_eval_exp(Fd, Funcs), + asn1ct_func:generate(Fd), + ok = file:close(Fd), halt(0). -gen_asn1ct_eval_exp(Funcs) -> - io:put_chars("-export(["), - gen_asn1ct_eval_exp_1(Funcs, ""), - io:put_chars("]).\n"). +gen_asn1ct_eval_exp(Fd, Funcs) -> + io:put_chars(Fd, "-export(["), + gen_asn1ct_eval_exp_1(Fd, Funcs, ""), + io:put_chars(Fd, "]).\n"). -gen_asn1ct_eval_exp_1([{_,F,A}|T], Sep) -> - io:put_chars(Sep), - io:format("~p/~p", [F,A]), - gen_asn1ct_eval_exp_1(T, ",\n"); -gen_asn1ct_eval_exp_1([], _) -> ok. +gen_asn1ct_eval_exp_1(Fd, [{_,F,A}|T], Sep) -> + io:put_chars(Fd, Sep), + io:format(Fd, "~p/~p", [F,A]), + gen_asn1ct_eval_exp_1(Fd, T, ",\n"); +gen_asn1ct_eval_exp_1(_, [], _) -> ok. -defined([H|T]) -> - io:format("assert_defined(~p) -> ok", [H]), +defined(Fd, [H|T]) -> + io:format(Fd, "assert_defined(~p) -> ok", [H]), case T of [] -> - io:put_chars(".\n"); + io:put_chars(Fd, ".\n"); [_|_] -> - io:put_chars(";\n"), - defined(T) + io:put_chars(Fd, ";\n"), + defined(Fd, T) end. -dependencies([{K,V}|T]) -> - io:format("dependencies(~p) ->\n~p;\n", [K,V]), - dependencies(T); -dependencies([]) -> - io:put_chars("dependencies(_) -> [].\n"). +dependencies(Fd, [{K,V}|T]) -> + io:format(Fd, "dependencies(~p) ->\n~p;\n", [K,V]), + dependencies(Fd, T); +dependencies(Fd, []) -> + io:put_chars(Fd, "dependencies(_) -> [].\n"). abstract(File) -> {ok,{M0,[{abstract_code,Abstract}]}} = -- cgit v1.2.3 From ffc5b4a516aa517bc4ccbb387c612a6bbea52ad4 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Mon, 30 Sep 2013 16:16:59 +0200 Subject: inets: added testcase for keep_alive_timeout --- lib/inets/test/httpd_basic_SUITE.erl | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index f164a2eda7..2d06f3e70c 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -39,7 +39,8 @@ all() -> script_nocache, escaped_url_in_error_body, script_timeout, - slowdose + slowdose, + keep_alive_timeout ]. groups() -> @@ -373,6 +374,26 @@ escaped_url_in_error_body(Config) when is_list(Config) -> %%------------------------------------------------------------------------- %%------------------------------------------------------------------------- +keep_alive_timeout(doc) -> + ["Test the keep_alive_timeout option"]; +keep_alive_timeout(suite) -> + []; +keep_alive_timeout(Config) when is_list(Config) -> + HttpdConf = ?config(httpd_conf, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, {keep_alive, true}, {keep_alive_timeout, 2} | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + _Address = proplists:get_value(bind_address, Info), + {ok, S} = gen_tcp:connect("localhost", Port, []), + receive + after 3000 -> + {error, closed} = gen_tcp:send(S, "hey") + end, + inets:stop(httpd, Pid). + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + script_timeout(doc) -> ["Test the httpd script_timeout option"]; script_timeout(suite) -> -- cgit v1.2.3 From 156b011958a3b80e507039ddc916db039874ada1 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 27 Aug 2013 17:23:09 +0200 Subject: erts: Refactor the ASSERT macro Introduce unconditional ERTS_ASSERT and use that for both ASSERT and ASSERT_EXPR. --- erts/emulator/beam/dist.c | 4 ++-- erts/emulator/beam/erl_alloc_util.c | 3 --- erts/emulator/beam/erl_ao_firstfit_alloc.c | 3 --- erts/emulator/beam/erl_bestfit_alloc.c | 3 --- erts/emulator/beam/erl_bif_info.c | 2 +- erts/emulator/beam/erl_binary.h | 4 ++-- erts/emulator/beam/erl_db.c | 4 ++-- erts/emulator/beam/io.c | 2 +- erts/emulator/beam/sys.h | 16 ++++++---------- erts/emulator/drivers/common/inet_drv.c | 2 +- erts/emulator/sys/unix/sys.c | 4 ++-- 11 files changed, 17 insertions(+), 30 deletions(-) diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 44f4eb9d43..aabccac822 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -353,7 +353,7 @@ static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp) static void doit_link_net_exits(ErtsLink *lnk, void *vnecp) { LinkNetExitsContext lnec = {(NetExitsContext *) vnecp, lnk}; - ASSERT(lnk->type == LINK_PID) + ASSERT(lnk->type == LINK_PID); erts_sweep_links(ERTS_LINK_ROOT(lnk), &doit_link_net_exits_sub, (void *) &lnec); #ifdef DEBUG ERTS_LINK_ROOT(lnk) = NULL; @@ -369,7 +369,7 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) Process *rp; ErtsLink *rlnk; Uint i,n; - ASSERT(lnk->type == LINK_NODE) + ASSERT(lnk->type == LINK_NODE); if (is_internal_pid(lnk->pid)) { ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 825b68bb85..3ea74a12f9 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -87,9 +87,6 @@ static int initialized = 0; #define SYS_ALLOC_CARRIER_CEILING(X) \ SYS_ALLOC_CARRIER_FLOOR((X) + INV_SYS_ALLOC_CARRIER_MASK) -#undef ASSERT -#define ASSERT ASSERT_EXPR - #if 0 /* Can be useful for debugging */ #define MBC_REALLOC_ALWAYS_MOVES diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 4e6c8b317e..396aa88e0b 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -85,9 +85,6 @@ #define SET_RED(N) (((AOFF_RBTree_t *) (N))->flags |= RED_FLG) #define SET_BLACK(N) (((AOFF_RBTree_t *) (N))->flags &= ~RED_FLG) -#undef ASSERT -#define ASSERT ASSERT_EXPR - #if 1 #define RBT_ASSERT ASSERT #else diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index 41f449bb28..59c14899a2 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -75,9 +75,6 @@ #define BF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr) -#undef ASSERT -#define ASSERT ASSERT_EXPR - #if 1 #define RBT_ASSERT ASSERT #else diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 3b25efd9af..a4f9f787cd 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2091,7 +2091,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(res); } else if (BIF_ARG_1 == am_sequential_tracer) { val = erts_get_system_seq_tracer(); - ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false) + ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_sequential_tracer, val); BIF_RET(res); diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 506c4813fa..331a12dc1c 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2000-2011. All Rights Reserved. + * Copyright Ericsson AB 2000-2013. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -183,7 +183,7 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen); #endif #define ERTS_CHK_BIN_ALIGNMENT(B) \ - do { ASSERT(!(B) || (((UWord) &((Binary *)(B))->orig_bytes[0]) & ERTS_BIN_ALIGNMENT_MASK) == ((UWord) 0)) } while(0) + do { ASSERT(!(B) || (((UWord) &((Binary *)(B))->orig_bytes[0]) & ERTS_BIN_ALIGNMENT_MASK) == ((UWord) 0)); } while(0) ERTS_GLB_INLINE byte* erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr); ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf); diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 40b8eaf8fb..41e64fcd4f 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -2236,7 +2236,7 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1) CHECK_TABLES(); tptr = tuple_val(a1); - ASSERT(arityval(*tptr) >= 1) + ASSERT(arityval(*tptr) >= 1); if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { BIF_ERROR(p, BADARG); @@ -2403,7 +2403,7 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1) CHECK_TABLES(); tptr = tuple_val(a1); - ASSERT(arityval(*tptr) >= 1) + ASSERT(arityval(*tptr) >= 1); if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { BIF_ERROR(p, BADARG); } diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index c1e66b59af..db19f6c142 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1330,7 +1330,7 @@ force_imm_drv_call(ErtsTryImmDrvCallState *sp) erts_aint32_t invalid_state; Port *prt = sp->port; - ASSERT(ERTS_IS_CRASH_DUMPING) + ASSERT(ERTS_IS_CRASH_DUMPING); ASSERT(is_atom(sp->port_op)); invalid_state = sp->state; diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 096394b878..a20106749c 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -149,20 +149,16 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; # define ERTS_EXIT_AFTER_DUMP exit #endif -#ifdef DEBUG -# define ASSERT(e) \ - if (e) { \ - ; \ - } else { \ - erl_assert_error(#e, __FILE__, __LINE__); \ - } -# define ASSERT_EXPR(e) \ +#define ERTS_ASSERT(e) \ ((void) ((e) ? 1 : (erl_assert_error(#e, __FILE__, __LINE__), 0))) void erl_assert_error(char* expr, char* file, int line); + +#ifdef DEBUG +# define ASSERT(e) ERTS_ASSERT(e) #else -# define ASSERT(e) -# define ASSERT_EXPR(e) ((void) 1) +# define ASSERT(e) ((void) 1) #endif +#define ASSERT_EXPR ASSERT /* * Microsoft C/C++: We certainly want to use stdarg.h and prototypes. diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 60db50e80a..12f45245b5 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -4433,7 +4433,7 @@ static ErlDrvSSizeT inet_ctl_getiflist(inet_descriptor* desc, case AF_INET6: #endif case AF_INET: - ASSERT(sp+IFNAMSIZ+1 < sbuf+ifc.ifc_len+1) + ASSERT(sp+IFNAMSIZ+1 < sbuf+ifc.ifc_len+1); strncpy(sp, ifrp->ifr_name, IFNAMSIZ); sp[IFNAMSIZ] = '\0'; sp += strlen(sp), ++sp; diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index fdc3167c62..47991756df 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -2638,8 +2638,6 @@ int fd; } -#ifdef DEBUG - extern int erts_initialized; void erl_assert_error(char* expr, char* file, int line) @@ -2661,6 +2659,8 @@ erl_assert_error(char* expr, char* file, int line) abort(); } +#ifdef DEBUG + void erl_debug(char* fmt, ...) { -- cgit v1.2.3 From ca1dc60a852c7827c2934ffeacefdd0119e2d776 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 27 Aug 2013 17:36:58 +0200 Subject: erts: Remove ASSERT_EXPR macro --- erts/emulator/beam/erl_alloc_util.h | 6 +++--- erts/emulator/beam/erl_binary.h | 2 +- erts/emulator/beam/erl_db_util.h | 2 +- erts/emulator/beam/erl_node_container_utils.h | 10 +++++----- erts/emulator/beam/erl_process.c | 2 +- erts/emulator/beam/erl_process.h | 4 ++-- erts/emulator/beam/erl_vm.h | 12 ++++++------ erts/emulator/beam/external.h | 4 ++-- erts/emulator/beam/global.h | 6 +++--- erts/emulator/beam/sys.h | 1 - 10 files changed, 24 insertions(+), 25 deletions(-) diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 70ecf28172..222f137024 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -254,9 +254,9 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); # define MBC_ABLK_SZ_MASK (~FLG_MASK) #endif -#define MBC_ABLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK) -#define MBC_FBLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_FBLK_SZ_MASK) -#define SBC_BLK_SZ(B) (ASSERT_EXPR(is_sbc_blk(B)), (B)->bhdr & SBC_BLK_SZ_MASK) +#define MBC_ABLK_SZ(B) (ASSERT(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK) +#define MBC_FBLK_SZ(B) (ASSERT(!is_sbc_blk(B)), (B)->bhdr & MBC_FBLK_SZ_MASK) +#define SBC_BLK_SZ(B) (ASSERT(is_sbc_blk(B)), (B)->bhdr & SBC_BLK_SZ_MASK) #define CARRIER_SZ(C) \ ((C)->chdr & CARRIER_SZ_MASK) diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 331a12dc1c..f7dc20f5e6 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -153,7 +153,7 @@ do { \ #define binary_bytes(Bin) \ (*binary_val(Bin) == HEADER_PROC_BIN ? \ ((ProcBin *) binary_val(Bin))->bytes : \ - (ASSERT_EXPR(thing_subtag(*binary_val(Bin)) == HEAP_BINARY_SUBTAG), \ + (ASSERT(thing_subtag(*binary_val(Bin)) == HEAP_BINARY_SUBTAG), \ (byte *)(&(((ErlHeapBin *) binary_val(Bin))->data)))) void erts_init_binary(void); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index 90b79e6044..328b19dfc9 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -457,7 +457,7 @@ int erts_db_is_compiled_ms(Eterm term); && ERTS_MAGIC_BIN_DESTRUCTOR((BP)) == erts_db_match_prog_destructor) #define Binary2MatchProg(BP) \ - (ASSERT_EXPR(IsMatchProgBinary((BP))), \ + (ASSERT(IsMatchProgBinary((BP))), \ ((MatchProg *) ERTS_MAGIC_BIN_DATA((BP)))) /* ** Debugging diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h index 0f93a3a9f0..17f6b32bb1 100644 --- a/erts/emulator/beam/erl_node_container_utils.h +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -106,7 +106,7 @@ #define dist_entry_channel_no(x) \ ((x) == erts_this_dist_entry \ ? ((Uint) 0) \ - : (ASSERT_EXPR(is_atom((x)->sysname)), \ + : (ASSERT(is_atom((x)->sysname)), \ (Uint) atom_val((x)->sysname))) #define internal_channel_no(x) ((Uint) ERST_INTERNAL_CHANNEL_NO) #define external_channel_no(x) \ @@ -122,10 +122,10 @@ extern ErtsPTab erts_proc; (D), \ _TAG_IMMED1_PID) -#define internal_pid_index(PID) (ASSERT_EXPR(is_internal_pid((PID))), \ +#define internal_pid_index(PID) (ASSERT(is_internal_pid((PID))), \ erts_ptab_id2pix(&erts_proc, (PID))) -#define internal_pid_data(PID) (ASSERT_EXPR(is_internal_pid((PID))), \ +#define internal_pid_data(PID) (ASSERT(is_internal_pid((PID))), \ erts_ptab_id2data(&erts_proc, (PID))) #define internal_pid_number(x) _GET_PID_NUM(internal_pid_data((x))) @@ -193,10 +193,10 @@ extern ErtsPTab erts_port; (D), \ _TAG_IMMED1_PORT) -#define internal_port_index(PRT) (ASSERT_EXPR(is_internal_port((PRT))), \ +#define internal_port_index(PRT) (ASSERT(is_internal_port((PRT))), \ erts_ptab_id2pix(&erts_port, (PRT))) -#define internal_port_data(PRT) (ASSERT_EXPR(is_internal_port((PRT))), \ +#define internal_port_data(PRT) (ASSERT(is_internal_port((PRT))), \ erts_ptab_id2data(&erts_port, (PRT))) #define internal_port_number(x) _GET_PORT_NUM(internal_port_data((x))) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 434d5ca147..79f382674a 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -294,7 +294,7 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist, ERTS_ALC_T_PROC_LIST) #define ERTS_SCHED_SLEEP_INFO_IX(IX) \ - (ASSERT_EXPR(-1 <= ((int) (IX)) \ + (ASSERT(-1 <= ((int) (IX)) \ && ((int) (IX)) < ((int) erts_no_schedulers)), \ &aligned_sched_sleep_info[(IX)].ssi) diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 8e5467f196..8d136f6e8b 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1135,10 +1135,10 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; } while (0) #define ERTS_RUNQ_IX(IX) \ - (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_run_queues), \ + (ASSERT(0 <= (IX) && (IX) < erts_no_run_queues), \ &erts_aligned_run_queues[(IX)].runq) #define ERTS_SCHEDULER_IX(IX) \ - (ASSERT_EXPR(0 <= (IX) && (IX) < erts_no_schedulers), \ + (ASSERT(0 <= (IX) && (IX) < erts_no_schedulers), \ &erts_aligned_scheduler_data[(IX)].esd) void erts_pre_init_process(void); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index c962955de9..8026243555 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2012. All Rights Reserved. + * Copyright Ericsson AB 1996-2013. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -98,7 +98,7 @@ * failing that, in a heap fragment. */ #define HAllocX(p, sz, xtra) \ - (ASSERT_EXPR((sz) >= 0), \ + (ASSERT((sz) >= 0), \ ErtsHAllocLockCheck(p), \ (IS_FORCE_HEAP_FRAGS || (((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ ? erts_heap_alloc((p),(sz),(xtra)) \ @@ -135,14 +135,14 @@ */ #ifdef CHECK_FOR_HOLES # define HeapOnlyAlloc(p, sz) \ - (ASSERT_EXPR((sz) >= 0), \ - (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ + (ASSERT((sz) >= 0), \ + (ASSERT(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ (erts_set_hole_marker(HEAP_TOP(p), (sz)), \ (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))) #else # define HeapOnlyAlloc(p, sz) \ - (ASSERT_EXPR((sz) >= 0), \ - (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ + (ASSERT((sz) >= 0), \ + (ASSERT(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) #endif diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index e37d47919e..ff29e84972 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -138,8 +138,8 @@ typedef struct { #define ERTS_DIST_EXT_SIZE(EDEP) \ (sizeof(ErtsDistExternal) \ - (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \ - ? (ASSERT_EXPR(0 <= (EDEP)->attab.size \ - && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \ + ? (ASSERT(0 <= (EDEP)->attab.size \ + && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \ sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - (EDEP)->attab.size)) \ : sizeof(ErtsAtomTranslationTable))) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index bacd5a5752..063d16c0c7 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -866,13 +866,13 @@ Eterm store_external_or_ref_in_proc_(Process *, Eterm); Eterm store_external_or_ref_(Uint **, ErlOffHeap*, Eterm); #define NC_HEAP_SIZE(NC) \ - (ASSERT_EXPR(is_node_container((NC))), \ + (ASSERT(is_node_container((NC))), \ IS_CONST((NC)) ? 0 : (thing_arityval(*boxed_val((NC))) + 1)) #define STORE_NC(Hpp, ETpp, NC) \ - (ASSERT_EXPR(is_node_container((NC))), \ + (ASSERT(is_node_container((NC))), \ IS_CONST((NC)) ? (NC) : store_external_or_ref_((Hpp), (ETpp), (NC))) #define STORE_NC_IN_PROC(Pp, NC) \ - (ASSERT_EXPR(is_node_container((NC))), \ + (ASSERT(is_node_container((NC))), \ IS_CONST((NC)) ? (NC) : store_external_or_ref_in_proc_((Pp), (NC))) /* duplicates from big.h */ diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index a20106749c..97e6ed8410 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -158,7 +158,6 @@ void erl_assert_error(char* expr, char* file, int line); #else # define ASSERT(e) ((void) 1) #endif -#define ASSERT_EXPR ASSERT /* * Microsoft C/C++: We certainly want to use stdarg.h and prototypes. -- cgit v1.2.3 From c2dbcb69929ac18e7687f1df1de6613b34e2897b Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 30 Aug 2013 11:59:49 +0200 Subject: erts: Prepare erl_mmap with tree structures for free seg storage --- erts/emulator/Makefile.in | 1 + erts/emulator/beam/erl_alloc.c | 37 ++ erts/emulator/beam/sys.h | 6 + erts/emulator/sys/common/erl_mmap.c | 972 ++++++++++++++++++++++++++++++++++++ erts/emulator/sys/common/erl_mmap.h | 26 + erts/emulator/sys/common/erl_mseg.c | 6 +- erts/emulator/sys/common/erl_mseg.h | 2 + erts/etc/common/erlexec.c | 3 + 8 files changed, 1052 insertions(+), 1 deletion(-) create mode 100644 erts/emulator/sys/common/erl_mmap.c create mode 100644 erts/emulator/sys/common/erl_mmap.h diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 9751982103..f442540f49 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -808,6 +808,7 @@ OS_OBJS += $(OBJDIR)/erl_poll.o \ endif OS_OBJS += $(OBJDIR)/erl_mseg.o \ + $(OBJDIR)/erl_mmap.o \ $(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \ $(OBJDIR)/erl_mtrace_sys_wrap.o \ $(OBJDIR)/erl_sys_common_misc.o diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 6dec383cee..2babe2f416 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1174,6 +1174,25 @@ get_kb_value(char *param_end, char** argv, int* ip) return ((Uint) tmp)*1024; } +static UWord +get_mb_value(char *param_end, char** argv, int* ip) +{ + SWord tmp; + UWord max = ((~((Uint) 0))/(1024*1024)) + 1; + char *rest; + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + errno = 0; + tmp = (SWord) ErtsStrToSint(value, &rest, 10); + if (errno != 0 || rest == value || tmp < 0 || max < ((UWord) tmp)) + bad_value(param, param_end, value); + if (max == (UWord) tmp) + return ~((UWord) 0); + else + return ((UWord) tmp)*1024*1024; +} + + #if 0 static Uint get_byte_value(char *param_end, char** argv, int* ip) @@ -1448,6 +1467,24 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) #endif get_amount_value(argv[i]+6, argv, &i); } + else if (has_prefix("scs", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.mmap.scs = +#endif + get_mb_value(argv[i]+6, argv, &i); + } + else if (has_prefix("sco", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.mmap.sco = +#endif + get_bool_value(argv[i]+6, argv, &i); + } + else if (has_prefix("scmgc", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.mmap.scmgc = +#endif + get_amount_value(argv[i]+8, argv, &i); + } else { bad_param(param, param+2); } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 97e6ed8410..dfe60d8ea0 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -277,16 +277,19 @@ typedef unsigned long UWord; typedef long SWord; #define SWORD_CONSTANT(Const) Const##L #define UWORD_CONSTANT(Const) Const##UL +#define ERTS_SWORD_MAX LONG_MAX #elif SIZEOF_VOID_P == SIZEOF_INT typedef unsigned int UWord; typedef int SWord; #define SWORD_CONSTANT(Const) Const #define UWORD_CONSTANT(Const) Const##U +#define ERTS_SWORD_MAX INT_MAX #elif SIZEOF_VOID_P == SIZEOF_LONG_LONG typedef unsigned long long UWord; typedef long long SWord; #define SWORD_CONSTANT(Const) Const##LL #define UWORD_CONSTANT(Const) Const##ULL +#define ERTS_SWORD_MAX LLONG_MAX #else #error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' #endif @@ -299,6 +302,7 @@ typedef unsigned long Uint; typedef long Sint; #define SWORD_CONSTANT(Const) Const##L #define UWORD_CONSTANT(Const) Const##UL +#define ERTS_SWORD_MAX LONG_MAX #define ERTS_SIZEOF_ETERM SIZEOF_LONG #define ErtsStrToSint strtol #elif SIZEOF_VOID_P == SIZEOF_INT @@ -307,6 +311,7 @@ typedef unsigned int Uint; typedef int Sint; #define SWORD_CONSTANT(Const) Const #define UWORD_CONSTANT(Const) Const##U +#define ERTS_SWORD_MAX INT_MAX #define ERTS_SIZEOF_ETERM SIZEOF_INT #define ErtsStrToSint strtol #elif SIZEOF_VOID_P == SIZEOF_LONG_LONG @@ -315,6 +320,7 @@ typedef unsigned long long Uint; typedef long long Sint; #define SWORD_CONSTANT(Const) Const##LL #define UWORD_CONSTANT(Const) Const##ULL +#define ERTS_SWORD_MAX LLONG_MAX #define ERTS_SIZEOF_ETERM SIZEOF_LONG_LONG #if defined(__WIN32__) #define ErtsStrToSint _strtoi64 diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c new file mode 100644 index 0000000000..a16ee7ae39 --- /dev/null +++ b/erts/emulator/sys/common/erl_mmap.c @@ -0,0 +1,972 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include +#include +#include + +#ifdef DEBUG +# define RBT_DEBUG +#endif +#ifdef RBT_DEBUG +# define RBT_ASSERT ERTS_ASSERT +# define IF_RBT_DEBUG(C) C +#else +# define RBT_ASSERT(x) +# define IF_RBT_DEBUG(C) +#endif + +typedef struct RBTNode_ RBTNode; +struct RBTNode_ { + RBTNode *parent; + RBTNode *left; + RBTNode *right; + int flags; +}; + +enum SortOrder { + ADDR_ORDER, + SZ_ADDR_ORDER, + SZ_REVERSE_ADDR_ORDER +}; + +typedef struct { + RBTNode* root; + enum SortOrder order; +}RBTree; + +#define RED_FLG (1) +#define IS_RED(N) ((N) && ((N)->flags & RED_FLG)) +#define IS_BLACK(N) (!IS_RED(N)) +#define SET_RED(N) ((N)->flags |= RED_FLG) +#define SET_BLACK(N) ((N)->flags &= ~RED_FLG) + +#define HARD_DEBUG /*SVERK*/ +#ifdef HARD_DEBUG +# define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE) +# define HARD_CHECK_TREE(TREE,SZ) check_tree(TREE, SZ) +static int rbt_assert_is_member(RBTNode* root, RBTNode* node); +static RBTNode* check_tree(RBTree* tree, Uint); +#else +# define HARD_CHECK_IS_MEMBER(ROOT,NODE) +# define HARD_CHECK_TREE(TREE,SZ) +#endif + + +typedef struct { + RBTNode snode; + RBTNode anode; + char* start; + char* end; +}ErtsFreeSegDesc; + +static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode) +{ + return (ErtsFreeSegDesc*) ((char*)anode - offsetof(ErtsFreeSegDesc, anode)); +} + +static ERTS_INLINE ErtsFreeSegDesc* snode_to_desc(RBTNode* snode) +{ + return (ErtsFreeSegDesc*) ((char*)snode - offsetof(ErtsFreeSegDesc, snode)); +} + +static ERTS_INLINE ErtsFreeSegDesc* node_to_desc(enum SortOrder order, RBTNode* node) +{ + return order==ADDR_ORDER ? anode_to_desc(node) : snode_to_desc(node); +} + +typedef struct { + RBTree stree; + RBTree atree; +}ErtsFreeSegMap; + + +#ifdef HARD_DEBUG +static ERTS_INLINE SWord cmp_blocks(enum SortOrder order, + RBTNode* lhs, RBTNode* rhs) +{ + ErtsFreeSegDesc* ldesc = node_to_desc(order, lhs); + ErtsFreeSegDesc* rdesc = node_to_desc(order, rhs); + RBT_ASSERT(lhs != rhs); + if (order != ADDR_ORDER) { + SWord lsz = ldesc->end - ldesc->start; + SWord rsz = rdesc->end - rdesc->start; + SWord diff = lsz - rsz; + if (diff) return diff; + } + if (order != SZ_REVERSE_ADDR_ORDER) { + return (char*)ldesc->start - (char*)rdesc->start; + } + else { + return (char*)rdesc->start - (char*)ldesc->start; + } +} +#endif + +static ERTS_INLINE SWord cmp_with_block(enum SortOrder order, + SWord sz, char* addr, RBTNode* rhs) +{ + ErtsFreeSegDesc* rdesc; + if (order != ADDR_ORDER) { + rdesc = snode_to_desc(rhs); + { + SWord rhs_sz = rdesc->end - rdesc->start; + SWord diff = sz - rhs_sz; + if (diff) return diff; + } + } + else + rdesc = anode_to_desc(rhs); + + if (order != SZ_REVERSE_ADDR_ORDER) + return addr - (char*)rdesc->start; + else + return (char*)rdesc->start - addr; +} + + +static ERTS_INLINE void +left_rotate(RBTNode **root, RBTNode *x) +{ + RBTNode *y = x->right; + x->right = y->left; + if (y->left) + y->left->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + y->left = x; + x->parent = y; + + /*SVERK y->max_sz = x->max_sz; + x->max_sz = node_max_size(x); + ASSERT(y->max_sz >= x->max_sz);*/ +} + +static ERTS_INLINE void +right_rotate(RBTNode **root, RBTNode *x) +{ + RBTNode *y = x->left; + x->left = y->right; + if (y->right) + y->right->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->right) + x->parent->right = y; + else { + RBT_ASSERT(x == x->parent->left); + x->parent->left = y; + } + y->right = x; + x->parent = y; + /*SVERK y->max_sz = x->max_sz; + x->max_sz = node_max_size(x); + ASSERT(y->max_sz >= x->max_sz);*/ +} + +/* + * Replace node x with node y + * NOTE: block header of y is not changed + */ +static ERTS_INLINE void +replace(RBTNode **root, RBTNode *x, RBTNode *y) +{ + + if (!x->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + if (x->left) { + RBT_ASSERT(x->left->parent == x); + x->left->parent = y; + } + if (x->right) { + RBT_ASSERT(x->right->parent == x); + x->right->parent = y; + } + + y->flags = x->flags; + y->parent = x->parent; + y->right = x->right; + y->left = x->left; + /*SVERK y->max_sz = x->max_sz;*/ +} + +static void +tree_insert_fixup(RBTNode** root, RBTNode *blk) +{ + RBTNode *x = blk, *y; + + /* + * Rearrange the tree so that it satisfies the Red-Black Tree properties + */ + + RBT_ASSERT(x != *root && IS_RED(x->parent)); + do { + + /* + * x and its parent are both red. Move the red pair up the tree + * until we get to the root or until we can separate them. + */ + + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(x->parent->parent); + + if (x->parent == x->parent->parent->left) { + y = x->parent->parent->right; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->right) { + x = x->parent; + left_rotate(root, x); + } + + RBT_ASSERT(x == x->parent->parent->left->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + right_rotate(root, x->parent->parent); + + RBT_ASSERT(x == x->parent->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->right)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + else { + RBT_ASSERT(x->parent == x->parent->parent->right); + y = x->parent->parent->left; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->left) { + x = x->parent; + right_rotate(root, x); + } + + RBT_ASSERT(x == x->parent->parent->right->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + left_rotate(root, x->parent->parent); + + RBT_ASSERT(x == x->parent->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->left)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + } while (x != *root && IS_RED(x->parent)); + + SET_BLACK(*root); +} + +static void +rbt_delete(RBTNode** root, RBTNode* del) +{ + Uint spliced_is_black; + RBTNode *x, *y, *z = del; + RBTNode null_x; /* null_x is used to get the fixup started when we + splice out a node without children. */ + + HARD_CHECK_IS_MEMBER(*root, del); + + null_x.parent = NULL; + + /* Remove node from tree... */ + + /* Find node to splice out */ + if (!z->left || !z->right) + y = z; + else + /* Set y to z:s successor */ + for(y = z->right; y->left; y = y->left); + /* splice out y */ + x = y->left ? y->left : y->right; + spliced_is_black = IS_BLACK(y); + if (x) { + x->parent = y->parent; + } + else if (spliced_is_black) { + x = &null_x; + x->flags = 0; + SET_BLACK(x); + x->right = x->left = NULL; + /*SVERK x->max_sz = 0;*/ + x->parent = y->parent; + y->left = x; + } + + if (!y->parent) { + RBT_ASSERT(*root == y); + *root = x; + } + else { + if (y == y->parent->left) { + y->parent->left = x; + } + else { + RBT_ASSERT(y == y->parent->right); + y->parent->right = x; + } + /*SVERK if (y->parent != z) { + lower_max_size(y->parent, (y==z ? NULL : z)); + }*/ + } + if (y != z) { + /* We spliced out the successor of z; replace z by the successor */ + RBT_ASSERT(z != &null_x); + replace(root, z, y); + /*SVERK lower_max_size(y, NULL);*/ + } + + if (spliced_is_black) { + /* We removed a black node which makes the resulting tree + violate the Red-Black Tree properties. Fixup tree... */ + + while (IS_BLACK(x) && x->parent) { + + /* + * x has an "extra black" which we move up the tree + * until we reach the root or until we can get rid of it. + * + * y is the sibbling of x + */ + + if (x == x->parent->left) { + y = x->parent->right; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + left_rotate(root, x->parent); + y = x->parent->right; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->left) && IS_BLACK(y->right)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->right)) { + SET_BLACK(y->left); + SET_RED(y); + right_rotate(root, y); + y = x->parent->right; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->right); + SET_BLACK(y->right); + left_rotate(root, x->parent); + x = *root; + break; + } + } + else { + RBT_ASSERT(x == x->parent->right); + y = x->parent->left; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + right_rotate(root, x->parent); + y = x->parent->left; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->right) && IS_BLACK(y->left)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->left)) { + SET_BLACK(y->right); + SET_RED(y); + left_rotate(root, y); + y = x->parent->left; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->left); + SET_BLACK(y->left); + right_rotate(root, x->parent); + x = *root; + break; + } + } + } + SET_BLACK(x); + + if (null_x.parent) { + if (null_x.parent->left == &null_x) + null_x.parent->left = NULL; + else { + RBT_ASSERT(null_x.parent->right == &null_x); + null_x.parent->right = NULL; + } + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + else if (*root == &null_x) { + *root = NULL; + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + } +} + + +static void +rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) +{ +#ifdef RBT_DEBUG + ErtsFreeSegDesc *dbg_under=NULL, *dbg_over=NULL; +#endif + ErtsFreeSegDesc* desc = node_to_desc(order, blk); + char* blk_addr = desc->start; + SWord blk_sz = desc->end - desc->start; + /*SVERK Uint blk_sz = AOFF_BLK_SZ(blk);*/ + + blk->flags = 0; + blk->left = NULL; + blk->right = NULL; + /*SVERK blk->max_sz = blk_sz;*/ + + if (!*root) { + blk->parent = NULL; + SET_BLACK(blk); + *root = blk; + } + else { + RBTNode *x = *root; + while (1) { + SWord diff; + /*SVERK if (x->max_sz < blk_sz) { + x->max_sz = blk_sz; + }*/ + diff = cmp_with_block(order, blk_sz, blk_addr, x); + if (diff < 0) { + IF_RBT_DEBUG(dbg_over = node_to_desc(order, x)); + if (!x->left) { + blk->parent = x; + x->left = blk; + break; + } + x = x->left; + } + else { + RBT_ASSERT(diff > 0); + IF_RBT_DEBUG(dbg_under = node_to_desc(order, x)); + if (!x->right) { + blk->parent = x; + x->right = blk; + break; + } + x = x->right; + } + /*SVERK else { + ASSERT(flavor == AOFF_BF); + ASSERT(blk->flags & IS_BF_FLG); + ASSERT(x->flags & IS_BF_FLG); + SET_LIST_ELEM(blk); + LIST_NEXT(blk) = LIST_NEXT(x); + LIST_PREV(blk) = x; + if (LIST_NEXT(x)) + LIST_PREV(LIST_NEXT(x)) = blk; + LIST_NEXT(x) = blk; + return; + }*/ + } + + /* Insert block into size tree */ + RBT_ASSERT(blk->parent); +#ifdef RBT_DEBUG + if (!order) { + RBT_ASSERT(!dbg_under || dbg_under->end < desc->start); + RBT_ASSERT(!dbg_over || dbg_over->start > desc->end); + } +#endif + SET_RED(blk); + if (IS_RED(blk->parent)) + tree_insert_fixup(root, blk); + } + /*SVERK if (flavor == AOFF_BF) { + SET_TREE_NODE(blk); + LIST_NEXT(blk) = NULL; + }*/ +} + + +/* The API to keep track of a bunch of separated free segments + (non-overlapping and non-adjacent). + */ +static void init_free_seg_map(ErtsFreeSegMap*, int reverse_ao); +static void adjacent_free_seg(ErtsFreeSegMap*, char* start, char* end, + ErtsFreeSegDesc** under, ErtsFreeSegDesc** over); +static void insert_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*, char* start, char* end); +static void resize_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*, char* start, char* end); +static void delete_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*); +static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap*, SWord sz); + + +static void init_free_seg_map(ErtsFreeSegMap* map, int reverse_ao) +{ + map->atree.root = NULL; + map->atree.order = ADDR_ORDER; + map->stree.root = NULL; + map->stree.order = reverse_ao ? SZ_REVERSE_ADDR_ORDER : SZ_ADDR_ORDER; +} + +static void adjacent_free_seg(ErtsFreeSegMap* map, char* start, char* end, + ErtsFreeSegDesc** under, ErtsFreeSegDesc** over) +{ + RBTNode* x = map->atree.root; + + *under = NULL; + *over = NULL; + while (x) { + if (start < anode_to_desc(x)->start) { + RBT_ASSERT(end <= anode_to_desc(x)->start); + if (end == anode_to_desc(x)->start) { + RBT_ASSERT(!*over); + *over = anode_to_desc(x); + } + x = x->left; + } + else { + RBT_ASSERT(start >= anode_to_desc(x)->end); + if (start == anode_to_desc(x)->end) { + RBT_ASSERT(!*under); + *under = anode_to_desc(x); + } + x = x->right; + } + } +} + +static void insert_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, + char* start, char* end) +{ + desc->start = start; + desc->end = end; + rbt_insert(map->atree.order, &map->atree.root, &desc->anode); + rbt_insert(map->stree.order, &map->stree.root, &desc->snode); +} + +static void resize_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, + char* start, char* end) +{ +#ifdef DEBUG + ErtsFreeSegDesc *dbg_under, *dbg_over; + rbt_delete(&map->atree.root, &desc->anode); + adjacent_free_seg(map, start, end, &dbg_under, &dbg_over); + RBT_ASSERT(dbg_under == NULL && dbg_over == NULL); + rbt_insert(map->atree.order, &map->atree.root, &desc->anode); +#endif + rbt_delete(&map->stree.root, &desc->snode); + desc->start = start; + desc->end = end; + rbt_insert(map->stree.order, &map->stree.root, &desc->snode); +} + +static void delete_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc) +{ + rbt_delete(&map->atree.root, &desc->anode); + rbt_delete(&map->stree.root, &desc->snode); +} + +static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) +{ + RBTNode* x = map->stree.root; + ErtsFreeSegDesc* best_desc = NULL; + + while (x) { + ErtsFreeSegDesc* desc = snode_to_desc(x); + SWord seg_sz = desc->end - desc->start; + + if (seg_sz < need_sz) { + x = x->right; + } + else { + best_desc = desc; + x = x->left; + } + } + return best_desc; +} + + +void erts_mmap_init(ErtsMMapInit* init) +{ +#ifdef HARD_DEBUG + erts_fprintf(stderr, "SVERK: scs = %bpu\n", init->scs); + erts_fprintf(stderr, "SVERK: sco = %i\n", init->sco); + erts_fprintf(stderr, "SVERK: scmgc = %i\n", init->scmgc); + + { + void test_it(void); + test_it(); + } +#endif +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + + +#ifdef HARD_DEBUG + +static int rbt_assert_is_member(RBTNode* root, RBTNode* node) +{ + while (node != root) { + RBT_ASSERT(node->parent); + RBT_ASSERT(node->parent->left == node || node->parent->right == node); + node = node->parent; + } + return 1; +} + +#define LEFT_VISITED_FLG 0x1000 +#define THIS_VISITED_FLG 0x100 +#define RIGHT_VISITED_FLG 0x10 +#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) +#define IS_THIS_VISITED(FB) ((FB)->flags & THIS_VISITED_FLG) +#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) + +#define SET_LEFT_VISITED(FB) ((FB)->flags |= LEFT_VISITED_FLG) +#define SET_THIS_VISITED(FB) ((FB)->flags |= THIS_VISITED_FLG) +#define SET_RIGHT_VISITED(FB) ((FB)->flags |= RIGHT_VISITED_FLG) + +#define UNSET_LEFT_VISITED(FB) ((FB)->flags &= ~LEFT_VISITED_FLG) +#define UNSET_THIS_VISITED(FB) ((FB)->flags &= ~THIS_VISITED_FLG) +#define UNSET_RIGHT_VISITED(FB) ((FB)->flags &= ~RIGHT_VISITED_FLG) + + + +#if 1 /*SVERK*/ +# define PRINT_TREE +#else +# undef PRINT_TREE +#endif + +#ifdef PRINT_TREE +static void print_tree(enum SortOrder order, RBTNode*); +#endif + +/* + * Checks that the order between parent and children are correct, + * and that the Red-Black Tree properies are satisfied. if size > 0, + * check_tree() returns the node that satisfies "address order first fit" + * + * The Red-Black Tree properies are: + * 1. Every node is either red or black. + * 2. Every leaf (NIL) is black. + * 3. If a node is red, then both its children are black. + * 4. Every simple path from a node to a descendant leaf + * contains the same number of black nodes. + * + */ + +static RBTNode * +check_tree(RBTree* tree, Uint size) +{ + RBTNode *res = NULL; + Sint blacks; + Sint curr_blacks; + RBTNode *x; + Uint depth, max_depth, node_cnt; + ErtsFreeSegDesc* seg = NULL; + ErtsFreeSegDesc* prev_seg = NULL; + +#ifdef PRINT_TREE + print_tree(tree->order, tree->root); +#endif + + if (!tree->root) + return res; + + x = tree->root; + RBT_ASSERT(IS_BLACK(x)); + RBT_ASSERT(!x->parent); + curr_blacks = 1; + blacks = -1; + depth = 1; + max_depth = 0; + node_cnt = 0; + + /* Traverse tree in sorting order */ + while (x) { + if (!IS_LEFT_VISITED(x)) { + SET_LEFT_VISITED(x); + if (x->left) { + x = x->left; + ++depth; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + } + } + + if (!IS_THIS_VISITED(x)) { + SET_THIS_VISITED(x); + ++node_cnt; + if (depth > max_depth) + max_depth = depth; + + if (IS_RED(x)) { + RBT_ASSERT(IS_BLACK(x->right)); + RBT_ASSERT(IS_BLACK(x->left)); + } + + RBT_ASSERT(x->parent || x == tree->root); + + if (x->left) { + RBT_ASSERT(x->left->parent == x); + RBT_ASSERT(cmp_blocks(tree->order, x->left, x) < 0); + } + + if (x->right) { + RBT_ASSERT(x->right->parent == x); + RBT_ASSERT(cmp_blocks(tree->order, x->right, x) > 0); + } + + seg = node_to_desc(tree->order, x); + RBT_ASSERT(seg->start < seg->end); + if (size && (seg->end - seg->start) >= size) { + if (!res || cmp_blocks(tree->order, x, res) < 0) { + res = x; + } + } + if (tree->order == ADDR_ORDER) { + RBT_ASSERT(!prev_seg || prev_seg->end < seg->start); + prev_seg = seg; + } + + } + if (!IS_RIGHT_VISITED(x)) { + SET_RIGHT_VISITED(x); + if (x->right) { + x = x->right; + ++depth; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + } + } + + UNSET_LEFT_VISITED(x); + UNSET_THIS_VISITED(x); + UNSET_RIGHT_VISITED(x); + if (IS_BLACK(x)) + curr_blacks--; + x = x->parent; + --depth; + } + RBT_ASSERT(depth == 0 || (!tree->root && depth==1)); + RBT_ASSERT(curr_blacks == 0); + RBT_ASSERT((1 << (max_depth/2)) <= node_cnt); + + UNSET_LEFT_VISITED(tree->root); + UNSET_THIS_VISITED(tree->root); + UNSET_RIGHT_VISITED(tree->root); + + return res; +} + + +#ifdef PRINT_TREE +#define INDENT_STEP 2 + +#include + +static void +print_tree_aux(enum SortOrder order, RBTNode *x, int indent) +{ + int i; + + if (x) { + ErtsFreeSegDesc* desc = node_to_desc(order, x); + print_tree_aux(order, x->right, indent + INDENT_STEP); + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "%s: sz=%lx [%p - %p] desc=%p\r\n", + IS_BLACK(x) ? "BLACK" : "RED", + desc->end - desc->start, desc->start, desc->end, desc); + print_tree_aux(order, x->left, indent + INDENT_STEP); + } +} + + +static void +print_tree(enum SortOrder order, RBTNode* root) +{ + static const char* type[] = {"Address","Size-Address","Size-RevAddress"}; + fprintf(stderr, " --- %s ordered tree begin ---\r\n", type[order]); + print_tree_aux(order, root, 0); + fprintf(stderr, " --- %s ordered tree end ---\r\n", type[order]); +} + +#endif /* PRINT_TREE */ + + +static ErtsFreeSegDesc* new_desc(void) +{ + return (ErtsFreeSegDesc*) malloc(sizeof(ErtsFreeSegDesc)); +} + +void test_it(void) +{ + ErtsFreeSegMap map; + ErtsFreeSegDesc *desc, *under, *over, *d1, *d2; + int i; + + for (i=0; i<2; i++) { + init_free_seg_map(&map, i); + + insert_free_seg(&map, new_desc(), (char*)0x11000, (char*)0x12000); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + insert_free_seg(&map, new_desc(), (char*)0x13000, (char*)0x14000); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + insert_free_seg(&map, new_desc(), (char*)0x15000, (char*)0x17000); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + insert_free_seg(&map, new_desc(), (char*)0x8000, (char*)0x10000); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + + desc = lookup_free_seg(&map, 0x500); + ERTS_ASSERT(desc->start == (char*)(i?0x13000L:0x11000L)); + + desc = lookup_free_seg(&map, 0x1500); + ERTS_ASSERT(desc->start == (char*)0x15000); + + adjacent_free_seg(&map, (char*)0x6666, (char*)0x7777, &under, &over); + ERTS_ASSERT(!under && !over); + + adjacent_free_seg(&map, (char*)0x6666, (char*)0x8000, &under, &over); + ERTS_ASSERT(!under && over->start == (char*)0x8000); + + adjacent_free_seg(&map, (char*)0x10000, (char*)0x10500, &under, &over); + ERTS_ASSERT(under->end == (char*)0x10000 && !over); + + adjacent_free_seg(&map, (char*)0x10100, (char*)0x10500, &under, &over); + ERTS_ASSERT(!under && !over); + + adjacent_free_seg(&map, (char*)0x10100, (char*)0x11000, &under, &over); + ERTS_ASSERT(!under && over && over->start == (char*)0x11000); + + adjacent_free_seg(&map, (char*)0x12000, (char*)0x12500, &under, &over); + ERTS_ASSERT(under && under->end == (char*)0x12000 && !over); + + adjacent_free_seg(&map, (char*)0x12000, (char*)0x13000, &under, &over); + ERTS_ASSERT(under && under->end == (char*)0x12000 && + over && over->start == (char*)0x13000); + + adjacent_free_seg(&map, (char*)0x12500, (char*)0x13000, &under, &over); + ERTS_ASSERT(!under && over && over->start == (char*)0x13000); + + d1 = lookup_free_seg(&map, 0x500); + ERTS_ASSERT(d1->start == (char*)(i?0x13000L:0x11000L)); + + resize_free_seg(&map, d1, d1->start - 0x800, (char*)d1->end); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + + d2 = lookup_free_seg(&map, 0x1200); + ERTS_ASSERT(d2 == d1); + + delete_free_seg(&map, d1); + check_tree(&map.atree, 0); check_tree(&map.stree, 0); + + d1 = lookup_free_seg(&map, 0x1200); + ERTS_ASSERT(d1->start == (char*)0x15000); + } +} + +#endif /* HARD_DEBUG */ diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h new file mode 100644 index 0000000000..64baa6c493 --- /dev/null +++ b/erts/emulator/sys/common/erl_mmap.h @@ -0,0 +1,26 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +typedef struct { + SWord scs; /* super carrier size */ + int sco; /* super carrier only? */ + Uint scmgc; /* super carrier: max guaranteed (number of) carriers */ +}ErtsMMapInit; + +void erts_mmap_init(ErtsMMapInit*); diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 2748edba02..64fcb6bb40 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1668,8 +1668,12 @@ erts_mseg_init(ErtsMsegInit_t *init) erl_exit(ERTS_ABORT_EXIT, "erts_mseg: unable to open /dev/zero\n"); #endif -#if HAVE_MMAP && HALFWORD_HEAP +#if HAVE_MMAP +# if HALFWORD_HEAP initialize_pmmap(); +# else + erts_mmap_init(&init->mmap); +# endif #endif if (!IS_2POW(GET_PAGE_SIZE)) diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index a1b000f51c..7454e5c473 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -22,6 +22,7 @@ #include "sys.h" #include "erl_alloc_types.h" +#include "erl_mmap.h" #ifndef HAVE_MMAP # define HAVE_MMAP 0 @@ -68,6 +69,7 @@ typedef struct { Uint rmcbf; Uint mcs; Uint nos; + ErtsMMapInit mmap; } ErtsMsegInit_t; #define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \ diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 30560f5a2f..1e01c5bc20 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -109,6 +109,9 @@ static char *plusM_other_switches[] = { "Mamcbf", "Mrmcbf", "Mmcs", + "Mscs", + "Mscmgc", + "Msco", "Ye", "Ym", "Ytp", -- cgit v1.2.3 From ef3da907bd566b43a4022f1cbb1ae3d103b9ec3e Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Fri, 23 Aug 2013 17:29:58 +0200 Subject: erts: erts_mmap supercarrier management and erts_mseg usage * Coalescing and trimming of free segments in supercarrier * Management of super aligned and super unaligned areas in supercarrier * Management of reservation of physical memory * erts_mseg usage of erts_mmap --- erts/emulator/beam/erl_alloc.c | 9 +- erts/emulator/beam/erl_alloc_util.c | 17 +- erts/emulator/beam/erl_lock_check.c | 3 +- erts/emulator/beam/erl_unicode.c | 3 + erts/emulator/beam/erl_vm.h | 2 +- erts/emulator/sys/common/erl_mmap.c | 1120 ++++++++++++++++++++++++++++++++++- erts/emulator/sys/common/erl_mmap.h | 89 ++- erts/emulator/sys/common/erl_mseg.c | 860 +++++---------------------- erts/emulator/sys/common/erl_mseg.h | 34 +- erts/etc/common/erlexec.c | 1 + 10 files changed, 1379 insertions(+), 759 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 2babe2f416..e30b3e7b51 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -718,6 +718,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.mseg.nos = erts_no_schedulers; erts_mseg_init(&init.mseg); #endif + erts_alcu_init(&init.alloc_util); erts_afalc_init(); erts_bfalc_init(); @@ -1178,7 +1179,7 @@ static UWord get_mb_value(char *param_end, char** argv, int* ip) { SWord tmp; - UWord max = ((~((Uint) 0))/(1024*1024)) + 1; + UWord max = ((~((UWord) 0))/(1024*1024)) + 1; char *rest; char *param = argv[*ip]+1; char *value = get_value(param_end, argv, ip); @@ -1479,6 +1480,12 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) #endif get_bool_value(argv[i]+6, argv, &i); } + else if (has_prefix("scrpm", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.mmap.scrpm = +#endif + get_bool_value(argv[i]+8, argv, &i); + } else if (has_prefix("scmgc", argv[i]+3)) { #if HAVE_ERTS_MSEG init->mseg.mmap.scmgc = diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 3ea74a12f9..1fdee4db2c 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -756,8 +756,9 @@ static ERTS_INLINE void * alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) { void *res; - - res = erts_mseg_alloc_opt(allctr->alloc_no, size_p, flags, &allctr->mseg_opt); + UWord size = (UWord) *size_p; + res = erts_mseg_alloc_opt(allctr->alloc_no, &size, flags, &allctr->mseg_opt); + *size_p = (Uint) size; INC_CC(allctr->calls.mseg_alloc); return res; } @@ -766,9 +767,10 @@ static ERTS_INLINE void * alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) { void *res; - - res = erts_mseg_realloc_opt(allctr->alloc_no, seg, old_size, new_size_p, + UWord new_size = (UWord) *new_size_p; + res = erts_mseg_realloc_opt(allctr->alloc_no, seg, (UWord) old_size, &new_size, ERTS_MSEG_FLG_NONE, &allctr->mseg_opt); + *new_size_p = (Uint) new_size; INC_CC(allctr->calls.mseg_realloc); return res; } @@ -776,7 +778,7 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) static ERTS_INLINE void alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) { - erts_mseg_dealloc_opt(allctr->alloc_no, seg, size, flags, &allctr->mseg_opt); + erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt); INC_CC(allctr->calls.mseg_dealloc); } @@ -3223,10 +3225,12 @@ static void CHECK_1BLK_CARRIER(Allctr_t* A, int SBC, int MSEGED, Carrier_t* C, ASSERT(IS_MBC_BLK((B))); ASSERT(IS_MB_CARRIER((C))); ASSERT(FBLK_TO_MBC(B) == (C)); + if ((MSEGED)) { + ASSERT_ERTS_SACRR_UNIT_SIZE_MULTIPLE((CSZ)); + } } if ((MSEGED)) { ASSERT(IS_MSEG_CARRIER((C))); - ASSERT_ERTS_SACRR_UNIT_SIZE_MULTIPLE((CSZ)); } else { ASSERT(IS_SYS_ALLOC_CARRIER((C))); @@ -3598,7 +3602,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(crr)) { - ASSERT(crr_sz % ERTS_SACRR_UNIT_SZ == 0); STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz); } else diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 2114d0c001..1e9cef3759 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -185,7 +185,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "sys_gethrtime", NULL }, #endif #endif - { "erts_alloc_hard_debug", NULL } + { "erts_alloc_hard_debug", NULL }, + { "erts_mmap", NULL } }; #define ERTS_LOCK_ORDER_SIZE \ diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index e00440b905..569c0a7d31 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1476,6 +1476,9 @@ static Eterm do_utf8_to_list_normalize(Process *p, Uint num, byte *bytes, Uint s Uint16 savepoints[4]; int numpoints = 0; + if (num == 0) + return NIL; + ASSERT(num > 0); hp = HAlloc(p,num * 2); /* May be to much */ diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 8026243555..337422eead 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -80,7 +80,7 @@ # ifdef CHECK_FOR_HOLES # define INIT_HEAP_MEM(p,sz) erts_set_hole_marker(HEAP_TOP(p), (sz)) # else -# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),DEBUG_BAD_BYTE,(sz)*sizeof(Eterm*)) +# define INIT_HEAP_MEM(p,sz) memset(HEAP_TOP(p),0x01,(sz)*sizeof(Eterm*)) # endif #else # define INIT_HEAP_MEM(p,sz) ((void)0) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index a16ee7ae39..aac01bf93c 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -20,11 +20,57 @@ # include "config.h" #endif -#include -#include +#include "sys.h" #include +#include "erl_smp.h" +#include "erl_mmap.h" -#ifdef DEBUG +#if defined(DEBUG) || 0 +# undef ERTS_MMAP_DEBUG +# define ERTS_MMAP_DEBUG +#endif + +/* #define ERTS_MMAP_DEBUG_FILL_AREAS */ + +#ifdef ERTS_MMAP_DEBUG +# define ERTS_MMAP_ASSERT(A) \ + ((void) (!(A) \ + ? erts_mmap_assert_failed(#A, __func__, __FILE__, __LINE__)\ + : 1)) +static int +erts_mmap_assert_failed(const char *a, const char *func, const char *file, int line) +{ + erts_fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", + (char *) file, line, (char *) func, (char *) a); + abort(); + return 0; +} +#else +# define ERTS_MMAP_ASSERT(A) ((void) 1) +#endif + +/* + * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after + * initialization, but the other pointers are not; i.e., only + * ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held. + */ +#define ERTS_MMAP_IN_SUPERCARRIER(PTR) \ + (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \ + < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot)) +#define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR) \ + (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \ + (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \ + < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot))) +#define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR) \ + (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \ + (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \ + < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot))) + +int erts_have_erts_mmap; +UWord erts_page_inv_mask; + +#if defined(DEBUG) || defined(ERTS_MMAP_DEBUG) +# undef RBT_DEBUG # define RBT_DEBUG #endif #ifdef RBT_DEBUG @@ -60,7 +106,7 @@ typedef struct { #define SET_RED(N) ((N)->flags |= RED_FLG) #define SET_BLACK(N) ((N)->flags &= ~RED_FLG) -#define HARD_DEBUG /*SVERK*/ +/* #define HARD_DEBUG */ #ifdef HARD_DEBUG # define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE) # define HARD_CHECK_TREE(TREE,SZ) check_tree(TREE, SZ) @@ -79,6 +125,134 @@ typedef struct { char* end; }ErtsFreeSegDesc; +typedef struct { + RBTree stree; + RBTree atree; +}ErtsFreeSegMap; + +static struct { + int (*reserve_physical)(char *, UWord); + void (*unreserve_physical)(char *, UWord); + int supercarrier; + int no_os_mmap; + /* + * Super unaligend area is located above super aligned + * area. That is, `sa.bot` is beginning of the super + * carrier, `sua.top` is the end of the super carrier, + * and sa.top and sua.bot moves towards eachother. + */ + struct { + char *top; + char *bot; + ErtsFreeSegMap map; + } sua; + struct { + char *top; + char *bot; + ErtsFreeSegMap map; + } sa; +#if HAVE_MMAP && (!defined(MAP_ANON) && !defined(MAP_ANONYMOUS)) + int mmap_fd; +#endif + erts_smp_mtx_t mtx; + char *desc_free_list; + struct { + struct { + UWord total; + struct { + UWord total; + UWord sa; + UWord sua; + } used; + } supercarrier; + struct { + UWord used; + } os; + } size; +} mmap_state; + +#define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \ + do { \ + mmap_state.size.supercarrier.used.total += (SZ); \ + mmap_state.size.supercarrier.used.sa += (SZ); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \ + <= mmap_state.size.supercarrier.total); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa \ + <= mmap_state.size.supercarrier.used.total); \ + } while (0) +#define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) \ + do { \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \ + mmap_state.size.supercarrier.used.total -= (SZ); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ)); \ + mmap_state.size.supercarrier.used.sa -= (SZ); \ + } while (0) +#define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) \ + do { \ + mmap_state.size.supercarrier.used.total += (SZ); \ + mmap_state.size.supercarrier.used.sua += (SZ); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \ + <= mmap_state.size.supercarrier.total); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua \ + <= mmap_state.size.supercarrier.used.total); \ + } while (0) +#define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) \ + do { \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \ + mmap_state.size.supercarrier.used.total -= (SZ); \ + ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ)); \ + mmap_state.size.supercarrier.used.sua -= (SZ); \ + } while (0) +#define ERTS_MMAP_SIZE_OS_INC(SZ) \ + do { \ + ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ)); \ + mmap_state.size.os.used += (SZ); \ + } while (0) +#define ERTS_MMAP_SIZE_OS_DEC(SZ) \ + do { \ + ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ)); \ + mmap_state.size.os.used -= (SZ); \ + } while (0) + +static void +add_free_desc_area(char *start, char *end) +{ + if (end > start && sizeof(ErtsFreeSegDesc) <= end - start) { + ErtsFreeSegDesc *prev_desc, *desc; + char *desc_end; + + prev_desc = (ErtsFreeSegDesc *) start; + prev_desc->start = mmap_state.desc_free_list; + desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc)); + desc_end = start + 2*sizeof(ErtsFreeSegDesc); + + while (desc_end <= end) { + desc->start = (char *) prev_desc; + prev_desc = desc; + desc = (ErtsFreeSegDesc *) desc_end; + desc_end += sizeof(ErtsFreeSegDesc); + } + mmap_state.desc_free_list = (char *) prev_desc; + } +} + +static ERTS_INLINE ErtsFreeSegDesc * +alloc_desc(void) +{ + ErtsFreeSegDesc *res; + res = (ErtsFreeSegDesc *) mmap_state.desc_free_list; + if (res) + mmap_state.desc_free_list = res->start; + return res; +} + +static ERTS_INLINE void +free_desc(ErtsFreeSegDesc *desc) +{ + desc->start = mmap_state.desc_free_list; + mmap_state.desc_free_list = (char *) desc; +} + static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode) { return (ErtsFreeSegDesc*) ((char*)anode - offsetof(ErtsFreeSegDesc, anode)); @@ -94,12 +268,6 @@ static ERTS_INLINE ErtsFreeSegDesc* node_to_desc(enum SortOrder order, RBTNode* return order==ADDR_ORDER ? anode_to_desc(node) : snode_to_desc(node); } -typedef struct { - RBTree stree; - RBTree atree; -}ErtsFreeSegMap; - - #ifdef HARD_DEBUG static ERTS_INLINE SWord cmp_blocks(enum SortOrder order, RBTNode* lhs, RBTNode* rhs) @@ -671,19 +839,927 @@ static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) return best_desc; } +#if ERTS_HAVE_OS_MMAP +/* Implementation of os_mmap()/os_munmap()/os_mremap()... */ + +#if HAVE_MMAP +# define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE) +# if defined(MAP_ANONYMOUS) +# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) +# define ERTS_MMAP_FD (-1) +# elif defined(MAP_ANON) +# define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) +# define ERTS_MMAP_FD (-1) +# else +# define ERTS_MMAP_FLAGS (MAP_PRIVATE) +# define ERTS_MMAP_FD mmap_state.mmap_fd +# endif +#endif -void erts_mmap_init(ErtsMMapInit* init) +static ERTS_INLINE void * +os_mmap(UWord size, int try_superalign) { -#ifdef HARD_DEBUG - erts_fprintf(stderr, "SVERK: scs = %bpu\n", init->scs); - erts_fprintf(stderr, "SVERK: sco = %i\n", init->sco); - erts_fprintf(stderr, "SVERK: scmgc = %i\n", init->scmgc); +#if HAVE_MMAP + void *res; +#ifdef MAP_ALIGN + if (try_superalign) + res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT, + ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0); + else +#endif + res = mmap((void *) 0, size, ERTS_MMAP_PROT, + ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0); + if (res == MAP_FAILED) + return NULL; + return res; +#elif HAVE_VIRTUALALLOC + return (void *) VirtualAlloc(NULL, (SIZE_T) size, + MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE); +#else +# error "missing mmap() or similar" +#endif +} + +static ERTS_INLINE void +os_munmap(void *ptr, UWord size) +{ +#if HAVE_MMAP +#ifdef ERTS_MMAP_DEBUG + int res = +#endif + munmap(ptr, size); + ERTS_MMAP_ASSERT(res == 0); +#elif HAVE_VIRTUALALLOC +#ifdef DEBUG + BOOL res = +#endif + VirtualFree((LPVOID) ptr, (SIZE_T) 0, MEM_RELEASE); + ERTS_MMAP_ASSERT(res != 0); +#else +# error "missing munmap() or similar" +#endif +} + +#ifdef ERTS_HAVE_OS_MREMAP +# if HAVE_MREMAP +# if defined(__NetBSD__) +# define ERTS_MREMAP_FLAGS (0) +# else +# define ERTS_MREMAP_FLAGS (MREMAP_MAYMOVE) +# endif +# endif +static ERTS_INLINE void * +os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign) +{ + void *new_seg; +#if HAVE_MREMAP + new_seg = mremap(ptr, (size_t) old_size, +# if defined(__NetBSD__) + NULL, +# endif + (size_t) new_size, ERTS_MREMAP_FLAGS); + if (new_seg == (void *) MAP_FAILED) + return NULL; + return new_seg; +#else +# error "missing mremap() or similar" +#endif +} +#endif + +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION +#if HAVE_MMAP + +#define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT) +#define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED) +#define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE) +#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED) +#define ERTS_MMAP_VIRTUAL_PROT (PROT_NONE) +#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE) + +static int +os_reserve_physical(char *ptr, UWord size) +{ + void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT, + ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0); + if (res == (void *) MAP_FAILED) + return 0; + return 1; +} + +static void +os_unreserve_physical(char *ptr, UWord size) +{ + void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_UNRESERVE_PROT, + ERTS_MMAP_UNRESERVE_FLAGS, ERTS_MMAP_FD, 0); + if (res == (void *) MAP_FAILED) + erl_exit(ERTS_ABORT_EXIT, "Failed to unreserve memory"); +} + +static void * +os_mmap_virtual(char *ptr, UWord size) +{ + void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT, + ERTS_MMAP_VIRTUAL_FLAGS, ERTS_MMAP_FD, 0); + if (res == (void *) MAP_FAILED) + return NULL; + return res; +} + +#else +#error "Missing reserve/unreserve physical memory implementation" +#endif +#endif /* ERTS_HAVE_OS_RESERVE_PHYSICAL_MEMORY */ + +#endif /* ERTS_HAVE_OS_MMAP */ + +static int reserve_noop(char *ptr, UWord size) +{ +#ifdef ERTS_MMAP_DEBUG_FILL_AREAS + Uint32 *uip, *end = (Uint32 *) (ptr + size); + + for (uip = (Uint32 *) ptr; uip < end; uip++) + ERTS_MMAP_ASSERT(*uip == (Uint32) 0xdeadbeef); + for (uip = (Uint32 *) ptr; uip < end; uip++) + *uip = (Uint32) 0xfeedfeed; +#endif + return 1; +} + +static void unreserve_noop(char *ptr, UWord size) +{ +#ifdef ERTS_MMAP_DEBUG_FILL_AREAS + Uint32 *uip, *end = (Uint32 *) (ptr + size); + + for (uip = (Uint32 *) ptr; uip < end; uip++) + *uip = (Uint32) 0xdeadbeef; +#endif +} + +void * +erts_mmap(Uint32 flags, UWord *sizep) +{ + char *seg; + UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep); + + /* Map in premapped supercarrier */ + if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) { + char *end; + ErtsFreeSegDesc *desc; + Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); + + erts_smp_mtx_lock(&mmap_state.mtx); + + if (!superaligned) { + desc = lookup_free_seg(&mmap_state.sua.map, asize); + if (desc) { + seg = desc->start; + end = seg+asize; + if (!mmap_state.reserve_physical(seg, asize)) + goto supercarrier_reserve_failure; + if (desc->end == end) { + delete_free_seg(&mmap_state.sua.map, desc); + free_desc(desc); + } + else { + ERTS_MMAP_ASSERT(end < desc->end); + resize_free_seg(&mmap_state.sua.map, desc, end, desc->end); + } + ERTS_MMAP_SIZE_SC_SUA_INC(asize); + goto supercarrier_success; + } + + if (asize <= mmap_state.sua.bot - mmap_state.sa.top) { + if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize, + asize)) + goto supercarrier_reserve_failure; + mmap_state.sua.bot -= asize; + seg = mmap_state.sua.bot; + ERTS_MMAP_SIZE_SC_SUA_INC(asize); + goto supercarrier_success; + } + } + + asize = ERTS_SUPERALIGNED_CEILING(asize); + + desc = lookup_free_seg(&mmap_state.sa.map, asize); + if (desc) { + seg = desc->start; + end = seg+asize; + if (!mmap_state.reserve_physical(seg, asize)) + goto supercarrier_reserve_failure; + if (desc->end == end) { + delete_free_seg(&mmap_state.sa.map, desc); + free_desc(desc); + } + else { + ERTS_MMAP_ASSERT(end < desc->end); + resize_free_seg(&mmap_state.sa.map, desc, end, desc->end); + } + ERTS_MMAP_SIZE_SC_SA_INC(asize); + goto supercarrier_success; + } + + if (superaligned) { + + if (asize <= mmap_state.sua.bot - mmap_state.sa.top) { + seg = (void *) mmap_state.sa.top; + if (!mmap_state.reserve_physical(seg, asize)) + goto supercarrier_reserve_failure; + mmap_state.sa.top += asize; + ERTS_MMAP_SIZE_SC_SA_INC(asize); + goto supercarrier_success; + } + + desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE); + if (desc) { + char *org_start = desc->start; + char *org_end = desc->end; + + seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start); + end = seg + asize; + if (!mmap_state.reserve_physical(seg, asize)) + goto supercarrier_reserve_failure; + if (org_start != seg) { + ERTS_MMAP_ASSERT(org_start < seg); + resize_free_seg(&mmap_state.sua.map, desc, org_start, seg); + desc = NULL; + } + if (end != org_end) { + ERTS_MMAP_ASSERT(end < org_end); + if (desc) + resize_free_seg(&mmap_state.sua.map, desc, end, org_end); + else { + desc = alloc_desc(); + if (!desc) + add_free_desc_area(end, org_end); + else + insert_free_seg(&mmap_state.sua.map, desc, end, org_end); + } + } + ERTS_MMAP_SIZE_SC_SA_INC(asize); + goto supercarrier_success; + } + } + + erts_smp_mtx_unlock(&mmap_state.mtx); + } + +#if ERTS_HAVE_OS_MMAP + /* Map using OS primitives */ + if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) { + if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) { + seg = os_mmap(asize, 0); + if (!seg) + return NULL; + } + else { + asize = ERTS_SUPERALIGNED_CEILING(*sizep); + seg = os_mmap(asize, 1); + if (!seg) + return NULL; + + if (!ERTS_IS_SUPERALIGNED(seg)) { + char *ptr; + UWord sz; + + os_munmap(seg, asize); + + ptr = os_mmap(asize + ERTS_SUPERALIGNED_SIZE, 1); + if (!ptr) + return NULL; + + seg = (char *) ERTS_SUPERALIGNED_CEILING(ptr); + sz = (UWord) (seg - ptr); + ERTS_MMAP_ASSERT(sz <= ERTS_SUPERALIGNED_SIZE); + if (sz) + os_munmap(ptr, sz); + sz = ERTS_SUPERALIGNED_SIZE - sz; + if (sz) + os_munmap(seg+asize, sz); + } + } + + ERTS_MMAP_SIZE_OS_INC(asize); + *sizep = asize; + return (void *) seg; + } +#endif + *sizep = 0; + return NULL; + +supercarrier_success: + +#ifdef ERTS_MMAP_DEBUG + if ((ERTS_MMAPFLG_SUPERALIGNED & flags) + || ERTS_MMAP_IN_SUPERALIGNED_AREA(seg)) { + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(seg)); + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); + } + else { + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(seg)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); + } +#endif + + erts_smp_mtx_unlock(&mmap_state.mtx); + + *sizep = asize; + return (void *) seg; + +supercarrier_reserve_failure: + erts_smp_mtx_unlock(&mmap_state.mtx); + + *sizep = 0; + return NULL; + +} + +void +erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) +{ + void *ptr = *ptrp; + UWord size = *sizep; + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size)); + if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { + ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap); +#if ERTS_HAVE_OS_MMAP + ERTS_MMAP_SIZE_OS_DEC(size); + os_munmap(ptr, size); +#endif + } + else { + char *start, *end; + ErtsFreeSegMap *map; + ErtsFreeSegDesc *prev, *next, *desc; + + ERTS_MMAP_ASSERT(mmap_state.supercarrier); + + start = (char *) ptr; + end = start + size; + + erts_smp_mtx_lock(&mmap_state.mtx); + + if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { + + start = (char *) ERTS_SUPERALIGNED_CEILING(start); + end = (char *) ERTS_SUPERALIGNED_FLOOR(end); + + size = (UWord) (end - start); + *ptrp = start; + *sizep = size; + + map = &mmap_state.sa.map; + adjacent_free_seg(map, start, end, &prev, &next); + + ERTS_MMAP_SIZE_SC_SA_DEC(size); + if (end == mmap_state.sa.top) { + ERTS_MMAP_ASSERT(!next); + if (prev) { + start = prev->start; + delete_free_seg(map, prev); + free_desc(prev); + } + mmap_state.sa.top = start; + goto supercarrier_success; + } + } + else { + ERTS_MMAP_ASSERT(ERTS_MMAP_IN_SUPERUNALIGNED_AREA(ptr)); + + map = &mmap_state.sua.map; + adjacent_free_seg(map, start, end, &prev, &next); + + ERTS_MMAP_SIZE_SC_SUA_DEC(size); + if (start == mmap_state.sua.bot) { + ERTS_MMAP_ASSERT(!prev); + if (next) { + end = next->end; + delete_free_seg(map, next); + free_desc(next); + } + mmap_state.sua.bot = end; + goto supercarrier_success; + } + } + + desc = NULL; + + if (next) { + ERTS_MMAP_ASSERT(end < next->end); + end = next->end; + if (prev) { + delete_free_seg(map, next); + free_desc(next); + goto save_prev; + } + desc = next; + } else if (prev) { + save_prev: + ERTS_MMAP_ASSERT(prev->start < start); + start = prev->start; + desc = prev; + } + + if (desc) + resize_free_seg(map, desc, start, end); + else { + desc = alloc_desc(); + if (desc) + insert_free_seg(map, desc, start, end); + else { + if (map == &mmap_state.sa.map) + ERTS_MMAP_SIZE_SC_SA_INC(size); + else + ERTS_MMAP_SIZE_SC_SUA_INC(size); + add_free_desc_area(start, end); + } + } + + supercarrier_success: + erts_smp_mtx_unlock(&mmap_state.mtx); + + mmap_state.unreserve_physical((char *) ptr, size); + } +} + +static void * +remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) +{ + UWord size = *sizep; + UWord um_size = old_size; + void *um_ptr = ptr; + void *new_ptr = erts_mmap(flags, &size); + if (!new_ptr) + return NULL; + *sizep = size; + if (old_size < size) + size = old_size; + sys_memcpy(new_ptr, ptr, (size_t) size); + erts_munmap(flags, &um_ptr, &um_size); + ERTS_MMAP_ASSERT(um_ptr == ptr); + ERTS_MMAP_ASSERT(um_size == old_size); + return new_ptr; +} + +void * +erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) +{ + void *new_ptr; + Uint32 superaligned; + UWord asize; + + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); + ERTS_MMAP_ASSERT(sizep && ERTS_IS_PAGEALIGNED(*sizep)); + + if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { + + ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap); + + if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) { + new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr, + old_size, sizep); + if (new_ptr) + return new_ptr; + } + + if (ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) + return NULL; + +#if ERTS_HAVE_OS_MREMAP || ERTS_HAVE_GENUINE_OS_MMAP + superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); + + if (superaligned) { + asize = ERTS_SUPERALIGNED_CEILING(*sizep); + if (asize == old_size && ERTS_IS_SUPERALIGNED(ptr)) { + *sizep = asize; + return ptr; + } + } + else { + asize = ERTS_PAGEALIGNED_CEILING(*sizep); + if (asize == old_size) { + *sizep = asize; + return ptr; + } + } + +#if ERTS_HAVE_GENUINE_OS_MMAP + if (asize < old_size + && (!superaligned + || ERTS_IS_SUPERALIGNED(ptr))) { + UWord um_sz; + new_ptr = ((char *) ptr) + asize; + ERTS_MMAP_ASSERT((((char *)ptr) + old_size) > (char *) new_ptr); + um_sz = (UWord) ((((char *) ptr) + old_size) - (char *) new_ptr); + ERTS_MMAP_SIZE_OS_DEC(um_sz); + os_munmap(new_ptr, um_sz); + *sizep = asize; + return ptr; + } +#endif +#if ERTS_HAVE_OS_MREMAP + if (superaligned) + return remap_move(flags, new_ptr, old_size, sizep); + else { + new_ptr = os_mremap(ptr, old_size, asize, 0); + if (!new_ptr) + return NULL; + if (asize > old_size) + ERTS_MMAP_SIZE_OS_INC(asize - old_size); + else + ERTS_MMAP_SIZE_OS_DEC(old_size - asize); + *sizep = asize; + return new_ptr; + } +#endif +#endif + } + else { /* In super carrier */ + char *start, *end, *new_end; + ErtsFreeSegMap *map; + ErtsFreeSegDesc *prev, *next, *desc; + + ERTS_MMAP_ASSERT(mmap_state.supercarrier); + + if (ERTS_MMAPFLG_OS_ONLY & flags) + return remap_move(flags, ptr, old_size, sizep); + + superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); + + asize = (superaligned + ? ERTS_SUPERALIGNED_CEILING(*sizep) + : ERTS_PAGEALIGNED_CEILING(*sizep)); + + erts_smp_mtx_lock(&mmap_state.mtx); + + if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr) + ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize)) + : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) { + erts_smp_mtx_unlock(&mmap_state.mtx); + /* + * Segment currently in wrong area (due to a previous memory + * shortage), move it to the right area. + * (remap_move() will succeed) + */ + return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr, + old_size, sizep); + } + + if (asize == old_size) { + new_ptr = ptr; + goto supercarrier_resize_success; + } + + start = (char *) ptr; + end = start + old_size; + new_end = start+asize; + + if (asize < old_size) { + new_ptr = ptr; + if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); + map = &mmap_state.sua.map; + ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize); + } + else { + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(old_size)); + if (!superaligned) { + /* must be a superaligned size in this area */ + asize = ERTS_SUPERALIGNED_CEILING(asize); + ERTS_MMAP_ASSERT(asize <= old_size); + if (asize == old_size) + goto supercarrier_resize_success; + new_end = start+asize; + } + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); + if (end == mmap_state.sa.top) { + mmap_state.sa.top = new_end; + mmap_state.unreserve_physical(((char *) ptr) + asize, + old_size - asize); + goto supercarrier_resize_success; + } + ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize); + map = &mmap_state.sa.map; + } + + adjacent_free_seg(map, start, end, &prev, &next); + + if (next) + resize_free_seg(map, next, new_end, next->end); + else { + desc = alloc_desc(); + if (desc) + insert_free_seg(map, desc, new_end, end); + else { + if (map == &mmap_state.sa.map) + ERTS_MMAP_SIZE_SC_SA_INC(old_size - asize); + else + ERTS_MMAP_SIZE_SC_SUA_INC(old_size - asize); + add_free_desc_area(new_end, end); + goto supercarrier_resize_success; + } + } + mmap_state.unreserve_physical(((char *) ptr) + asize, + old_size - asize); + goto supercarrier_resize_success; + } + + if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); + + adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next); + + if (next && new_end <= next->end) { + if (!mmap_state.reserve_physical(((char *) ptr) + old_size, + asize - old_size)) + goto supercarrier_reserve_failure; + if (new_end < next->end) + resize_free_seg(&mmap_state.sua.map, next, new_end, next->end); + else { + delete_free_seg(&mmap_state.sua.map, next); + free_desc(next); + } + new_ptr = ptr; + ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size); + goto supercarrier_resize_success; + } + } + else { /* Superaligned area */ + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(old_size)); + + if (!superaligned) { + /* must be a superaligned size in this area */ + asize = ERTS_PAGEALIGNED_CEILING(asize); + new_end = start+asize; + } + + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); + + if (end == mmap_state.sa.top) { + if (new_end <= mmap_state.sua.bot) { + if (!mmap_state.reserve_physical(((char *) ptr) + old_size, + asize - old_size)) + goto supercarrier_reserve_failure; + mmap_state.sa.top = new_end; + new_ptr = ptr; + ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size); + goto supercarrier_resize_success; + } + } + else { + adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next); + if (next && new_end <= next->end) { + if (!mmap_state.reserve_physical(((char *) ptr) + old_size, + asize - old_size)) + goto supercarrier_reserve_failure; + if (new_end < next->end) + resize_free_seg(&mmap_state.sa.map, next, new_end, next->end); + else { + delete_free_seg(&mmap_state.sa.map, next); + free_desc(next); + } + new_ptr = ptr; + ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size); + goto supercarrier_resize_success; + } + } + } + erts_smp_mtx_unlock(&mmap_state.mtx); + + /* Failed to resize... */ + } + + return remap_move(flags, ptr, old_size, sizep); + +supercarrier_resize_success: + +#ifdef ERTS_MMAP_DEBUG + if ((ERTS_MMAPFLG_SUPERALIGNED & flags) + || ERTS_MMAP_IN_SUPERALIGNED_AREA(new_ptr)) { + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(new_ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); + } + else { + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(new_ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); + } +#endif + + erts_smp_mtx_unlock(&mmap_state.mtx); + + *sizep = asize; + return new_ptr; + +supercarrier_reserve_failure: + + erts_smp_mtx_unlock(&mmap_state.mtx); + *sizep = 0; + return NULL; + +} + +int erts_mmap_in_supercarrier(void *ptr) +{ + return ERTS_MMAP_IN_SUPERCARRIER(ptr); +} + +void +erts_mmap_init(ErtsMMapInit *init) +{ + int virtual_map = 0; + char *start = NULL, *end = NULL; + UWord pagesize; +#if defined(__WIN32__) + SYSTEM_INFO sysinfo; + GetSystemInfo(&sysinfo); + pagesize = (UWord) sysinfo.dwPageSize; +#elif defined(_SC_PAGESIZE) + pagesize = (UWord) sysconf(_SC_PAGESIZE); +#elif defined(HAVE_GETPAGESIZE) + pagesize = (UWord) getpagesize(); +#else +# error "Do not know how to get page size" +#endif +#if defined(HARD_DEBUG) || 0 + erts_fprintf(stderr, "erts_mmap: scs = %bpu\n", init->scs); + erts_fprintf(stderr, "erts_mmap: sco = %i\n", init->sco); + erts_fprintf(stderr, "erts_mmap: scmgc = %i\n", init->scmgc); +#endif + erts_page_inv_mask = pagesize - 1; + if (pagesize & erts_page_inv_mask) + erl_exit(-1, "erts_mmap: Invalid pagesize: %bpu\n", + pagesize); + + erts_have_erts_mmap = 0; + + mmap_state.reserve_physical = reserve_noop; + mmap_state.unreserve_physical = unreserve_noop; + +#if HAVE_MMAP && !defined(MAP_ANON) + mmap_state.mmap_fd = open("/dev/zero", O_RDWR); + if (mmap_state.mmap_fd < 0) + erl_exit(-1, "erts_mmap: Failed to open /dev/zero\n"); +#endif + + erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap"); + +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + if (init->virtual_range.start) { + char *ptr; + UWord sz; + ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start); + end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end); + sz = end - ptr; + start = os_mmap_virtual(ptr, sz); + if (!start || start > ptr || start >= end) + erl_exit(-1, + "erts_mmap: Failed to create virtual range for super carrier\n"); + sz = start - ptr; + if (sz) + os_munmap(end, sz); + mmap_state.reserve_physical = os_reserve_physical; + mmap_state.unreserve_physical = os_unreserve_physical; + virtual_map = 1; + } + else +#endif + if (init->predefined_area.start) { + start = init->predefined_area.start; + end = init->predefined_area.end; + if (end != (void *) 0 && end < start) + end = start; + } +#if ERTS_HAVE_OS_MMAP + else if (init->scs) { + UWord sz; + sz = ERTS_PAGEALIGNED_CEILING(init->scs); +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + if (!init->scrpm) { + start = os_mmap_virtual(NULL, sz); + mmap_state.reserve_physical = os_reserve_physical; + mmap_state.unreserve_physical = os_unreserve_physical; + virtual_map = 1; + } + else +#endif + { + /* + * The whole supercarrier will by physically + * reserved all the time. + */ + start = os_mmap(sz, 1); + } + if (!start) + erl_exit(-1, + "erts_mmap: Failed to create super carrier of size %bpu MB\n", + init->scs/1024/1024); + end = start + sz; +#ifdef ERTS_MMAP_DEBUG_FILL_AREAS + if (!virtual_map) { + Uint32 *uip; + + for (uip = (Uint32 *) start; uip < (Uint32 *) end; uip++) + *uip = (Uint32) 0xdeadbeef; + } +#endif + } + if (!mmap_state.no_os_mmap) + erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP; +#endif + + mmap_state.size.supercarrier.total = 0; + mmap_state.size.supercarrier.used.total = 0; + mmap_state.size.supercarrier.used.sa = 0; + mmap_state.size.supercarrier.used.sua = 0; + mmap_state.size.os.used = 0; + + if (!start) { + mmap_state.sa.bot = NULL; + mmap_state.sua.top = NULL; + mmap_state.sa.bot = NULL; + mmap_state.sua.top = NULL; + mmap_state.no_os_mmap = 0; + } + else { + size_t desc_size; + + mmap_state.no_os_mmap = init->sco; + + desc_size = init->scmgc; + if (desc_size < 100) + desc_size = 100; + desc_size *= sizeof(ErtsFreeSegDesc); + if ((desc_size + + ERTS_SUPERALIGNED_SIZE + + ERTS_PAGEALIGNED_SIZE) > end - start) + erl_exit(-1, "erts_mmap: No space for segments in super carrier\n"); + + mmap_state.sa.bot = start; + mmap_state.sa.bot += desc_size; + mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot); + mmap_state.sa.top = mmap_state.sa.bot; + mmap_state.sua.top = (char *) ERTS_SUPERALIGNED_FLOOR(end); + mmap_state.sua.bot = mmap_state.sua.top; + + mmap_state.size.os.used += (UWord) (mmap_state.sa.bot - start); + + if (end == (void *) 0) { + /* + * Very unlikely, but we need a guarantee + * that `mmap_state.sua.top` always will + * compare as larger than all segment pointers + * into the super carrier... + */ + mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE; + mmap_state.size.os.used += ERTS_PAGEALIGNED_SIZE; + } + + mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - mmap_state.sa.bot); + + /* + * Area before (and after) super carrier + * will be used for free segment descritors. + */ + mmap_state.desc_free_list = NULL; +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + if (virtual_map && mmap_state.sa.bot - start > 0) + os_reserve_physical(start, mmap_state.sa.bot - start); +#endif + add_free_desc_area(start, mmap_state.sa.bot); +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + if (virtual_map && end - mmap_state.sua.top > 0) + os_reserve_physical(mmap_state.sua.top, end - mmap_state.sua.top); +#endif + add_free_desc_area(mmap_state.sua.top, end); + + init_free_seg_map(&mmap_state.sa.map, 0); + init_free_seg_map(&mmap_state.sua.map, 1); + + mmap_state.supercarrier = 1; + erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; + +#ifdef HARD_DEBUG { void test_it(void); test_it(); } #endif + + } +#if !ERTS_HAVE_OS_MMAP + mmap_state.no_os_mmap = 1; +#endif + } @@ -897,12 +1973,6 @@ print_tree(enum SortOrder order, RBTNode* root) #endif /* PRINT_TREE */ - -static ErtsFreeSegDesc* new_desc(void) -{ - return (ErtsFreeSegDesc*) malloc(sizeof(ErtsFreeSegDesc)); -} - void test_it(void) { ErtsFreeSegMap map; @@ -912,13 +1982,13 @@ void test_it(void) for (i=0; i<2; i++) { init_free_seg_map(&map, i); - insert_free_seg(&map, new_desc(), (char*)0x11000, (char*)0x12000); + insert_free_seg(&map, alloc_desc(), (char*)0x11000, (char*)0x12000); check_tree(&map.atree, 0); check_tree(&map.stree, 0); - insert_free_seg(&map, new_desc(), (char*)0x13000, (char*)0x14000); + insert_free_seg(&map, alloc_desc(), (char*)0x13000, (char*)0x14000); check_tree(&map.atree, 0); check_tree(&map.stree, 0); - insert_free_seg(&map, new_desc(), (char*)0x15000, (char*)0x17000); + insert_free_seg(&map, alloc_desc(), (char*)0x15000, (char*)0x17000); check_tree(&map.atree, 0); check_tree(&map.stree, 0); - insert_free_seg(&map, new_desc(), (char*)0x8000, (char*)0x10000); + insert_free_seg(&map, alloc_desc(), (char*)0x8000, (char*)0x10000); check_tree(&map.atree, 0); check_tree(&map.stree, 0); desc = lookup_free_seg(&map, 0x500); diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 64baa6c493..143f1aff3e 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2013. All Rights Reserved. + * Copyright Ericsson AB 2013. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -17,10 +17,95 @@ * %CopyrightEnd% */ +#ifndef ERL_MMAP_H__ +#define ERL_MMAP_H__ + +#include "sys.h" + +#define ERTS_MMAP_SUPERALIGNED_BITS (18) +/* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */ + +#define ERTS_MMAPFLG_OS_ONLY (((Uint32) 1) << 0) +#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1) +#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2) + +#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0) +#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1) +extern int erts_have_erts_mmap; +extern UWord erts_page_inv_mask; + typedef struct { - SWord scs; /* super carrier size */ + struct { + char *start; + char *end; + } virtual_range; + struct { + char *start; + char *end; + } predefined_area; + UWord scs; /* super carrier size */ int sco; /* super carrier only? */ Uint scmgc; /* super carrier: max guaranteed (number of) carriers */ + int scrpm; }ErtsMMapInit; +#define ERTS_MMAP_INIT_DEFAULT_INITER \ + {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1} + +void *erts_mmap(Uint32 flags, UWord *sizep); +void erts_munmap(Uint32 flags, void **ptrp, UWord *sizep); +void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep); +int erts_mmap_in_supercarrier(void *ptr); void erts_mmap_init(ErtsMMapInit*); + +#define ERTS_SUPERALIGNED_SIZE \ + (1 << ERTS_MMAP_SUPERALIGNED_BITS) +#define ERTS_INV_SUPERALIGNED_MASK \ + ((UWord) (ERTS_SUPERALIGNED_SIZE - 1)) +#define ERTS_SUPERALIGNED_MASK \ + (~ERTS_INV_SUPERALIGNED_MASK) +#define ERTS_SUPERALIGNED_FLOOR(X) \ + (((UWord) (X)) & ERTS_SUPERALIGNED_MASK) +#define ERTS_SUPERALIGNED_CEILING(X) \ + ERTS_SUPERALIGNED_FLOOR((X) + ERTS_INV_SUPERALIGNED_MASK) +#define ERTS_IS_SUPERALIGNED(X) \ + (((UWord) (X) & ERTS_INV_SUPERALIGNED_MASK) == 0) + +#define ERTS_INV_PAGEALIGNED_MASK \ + (erts_page_inv_mask) +#define ERTS_PAGEALIGNED_MASK \ + (~ERTS_INV_PAGEALIGNED_MASK) +#define ERTS_PAGEALIGNED_FLOOR(X) \ + (((UWord) (X)) & ERTS_PAGEALIGNED_MASK) +#define ERTS_PAGEALIGNED_CEILING(X) \ + ERTS_PAGEALIGNED_FLOOR((X) + ERTS_INV_PAGEALIGNED_MASK) +#define ERTS_IS_PAGEALIGNED(X) \ + (((UWord) (X) & ERTS_INV_PAGEALIGNED_MASK) == 0) +#define ERTS_PAGEALIGNED_SIZE \ + (ERTS_INV_PAGEALIGNED_MASK + 1) + +#ifndef HAVE_MMAP +# define HAVE_MMAP 0 +#endif +#ifndef HAVE_MREMAP +# define HAVE_MREMAP 0 +#endif +#if HAVE_MMAP +# define ERTS_HAVE_OS_MMAP 1 +# define ERTS_HAVE_GENUINE_OS_MMAP 1 +# if HAVE_MREMAP +# define ERTS_HAVE_OS_MREMAP 1 +# endif +# if defined(MAP_FIXED) && defined(MAP_NORESERVE) +# define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1 +# endif +#endif + +#ifndef HAVE_VIRTUALALLOC +# define HAVE_VIRTUALALLOC 0 +#endif +#if HAVE_VIRTUALALLOC +# define ERTS_HAVE_OS_MMAP 1 +#endif + +#endif /* ERL_MMAP_H__ */ diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 64fcb6bb40..b21d6ca393 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -100,45 +100,6 @@ static int atoms_initialized; typedef struct mem_kind_t MemKind; -#if HALFWORD_HEAP -static int initialize_pmmap(void); -static void *pmmap(size_t size); -static int pmunmap(void *p, size_t size); -static void *pmremap(void *old_address, size_t old_size, - size_t new_size); -#endif - -#if HAVE_MMAP -/* Mmap ... */ - -#define MMAP_PROT (PROT_READ|PROT_WRITE) - - -#ifdef MAP_ANON -# define MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) -# define MMAP_FD (-1) -#else -# define MMAP_FLAGS (MAP_PRIVATE) -# define MMAP_FD mmap_fd -static int mmap_fd; -#endif - -#if HAVE_MREMAP -# define HAVE_MSEG_RECREATE 1 -#else -# define HAVE_MSEG_RECREATE 0 -#endif - -#if HALFWORD_HEAP -#define CAN_PARTLY_DESTROY 0 -#else -#define CAN_PARTLY_DESTROY 1 -#endif -#else /* #if HAVE_MMAP */ -#define CAN_PARTLY_DESTROY 0 -#error "Not supported" -#endif /* #if HAVE_MMAP */ - const ErtsMsegOpt_t erts_mseg_default_opt = { 1, /* Use cache */ 1, /* Preserv data */ @@ -163,9 +124,7 @@ typedef struct { CallCounter create; CallCounter create_resize; CallCounter destroy; -#if HAVE_MSEG_RECREATE CallCounter recreate; -#endif CallCounter clear_cache; CallCounter check_cache; } ErtsMsegCalls; @@ -236,11 +195,6 @@ struct ErtsMsegAllctr_t_ { Uint rel_max_cache_bad_fit; ErtsMsegCalls calls; - -#if CAN_PARTLY_DESTROY - Uint min_seg_size; -#endif - }; typedef union { @@ -344,69 +298,31 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) { } } -/* remove ErtsMsegAllctr_t from arguments? - * only used for statistics - */ -static ERTS_INLINE void * -mmap_align(ErtsMsegAllctr_t *ma, void *addr, size_t length, int prot, int flags, int fd, off_t offset) { - - char *p, *q; - UWord d; - - p = mmap(addr, length, prot, flags, fd, offset); - - if (MAP_IS_ALIGNED(p) || p == MAP_FAILED) - return p; - - if (ma) - INC_CC(ma, create_resize); - - munmap(p, length); - - if ((p = mmap(addr, length + MSEG_ALIGNED_SIZE, prot, flags, fd, offset)) == MAP_FAILED) - return MAP_FAILED; - - q = (void *)ALIGNED_CEILING((char *)p); - d = (UWord)(q - p); - - if (d > 0) - munmap(p, d); - - if (MSEG_ALIGNED_SIZE - d > 0) - munmap((void *)(q + length), MSEG_ALIGNED_SIZE - d); - - return q; -} +/* #define ERTS_PRINT_ERTS_MMAP */ static ERTS_INLINE void * -mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) +mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) { +#ifdef ERTS_PRINT_ERTS_MMAP + UWord req_size = *sizep; +#endif void *seg; - ASSERT(size % MSEG_ALIGNED_SIZE == 0); - + Uint32 mmap_flags = 0; #if HALFWORD_HEAP - if (mk == &ma->low_mem) { - seg = pmmap(size); - if ((unsigned long) seg & CHECK_POINTER_MASK) { - erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); - return NULL; - } - } else + mmap_flags |= ((mk == &ma->low_mem) + ? ERTS_MMAPFLG_SUPERCARRIER_ONLY + : ERTS_MMAPFLG_OS_ONLY); #endif - { -#if HAVE_MMAP - { - seg = (void *) mmap_align(ma, (void *) 0, (size_t) size, - MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); - if (seg == (void *) MAP_FAILED) - seg = NULL; - - ASSERT(MAP_IS_ALIGNED(seg) || !seg); - } -#else -# error "Missing mseg_create() implementation" + if (MSEG_FLG_IS_2POW(flags)) + mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; + + seg = erts_mmap(mmap_flags, sizep); + +#ifdef ERTS_PRINT_ERTS_MMAP + erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg, + (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua", + req_size, *sizep); #endif - } INC_CC(ma, create); @@ -414,91 +330,55 @@ mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) } static ERTS_INLINE void -mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) { - ERTS_DECLARE_DUMMY(int res); - +mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void **seg_pp, UWord *size_p) { + + Uint32 mmap_flags = 0; #if HALFWORD_HEAP - if (mk == &ma->low_mem) { - res = pmunmap((void *) seg, size); - } - else + mmap_flags |= ((mk == &ma->low_mem) + ? ERTS_MMAPFLG_SUPERCARRIER_ONLY + : ERTS_MMAPFLG_OS_ONLY); #endif - { -#ifdef HAVE_MMAP - res = munmap((void *) seg, size); -#else -# error "Missing mseg_destroy() implementation" + if (MSEG_FLG_IS_2POW(flags)) + mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; + + erts_munmap(mmap_flags, seg_pp, size_p); +#ifdef ERTS_PRINT_ERTS_MMAP + erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n", + (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua", + *seg_pp, *size_p); #endif - } - - ASSERT(size % MSEG_ALIGNED_SIZE == 0); - ASSERT(res == 0); - INC_CC(ma, destroy); } -#if HAVE_MSEG_RECREATE -#if defined(__NetBSD__) -#define MREMAP_FLAGS (0) -#else -#define MREMAP_FLAGS (MREMAP_MAYMOVE) -#endif - - -/* mseg_recreate - * May return *unaligned* segments as in address not aligned to MSEG_ALIGNMENT - * it is still page aligned - * - * This is fine for single block carriers as long as we don't cache misaligned - * segments (since multiblock carriers may use them) - * - * For multiblock carriers we *need* MSEG_ALIGNMENT but mbc's will never be - * reallocated. - * - * This should probably be fixed the following way: - * 1) Use an option to segment allocation - NEED_ALIGNMENT - * 2) Add mremap_align which takes care of aligning a new a mremaped area - * 3) Fix the cache to handle of aligned and unaligned segments - */ - static ERTS_INLINE void * -mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, Uint new_size) +mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep) { +#ifdef ERTS_PRINT_ERTS_MMAP + UWord req_size = *sizep; +#endif void *new_seg; - - ASSERT(old_size % MSEG_ALIGNED_SIZE == 0); - ASSERT(new_size % MSEG_ALIGNED_SIZE == 0); - + Uint32 mmap_flags = 0; #if HALFWORD_HEAP - if (mk == &ma->low_mem) { - new_seg = (void *) pmremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size); - } - else -#endif - { -#if HAVE_MREMAP -#if defined(__NetBSD__) - new_seg = mremap(old_seg, (size_t)old_size, NULL, new_size, MREMAP_FLAGS); -#else - new_seg = mremap(old_seg, (size_t)old_size, (size_t)new_size, MREMAP_FLAGS); + mmap_flags |= ((mk == &ma->low_mem) + ? ERTS_MMAPFLG_SUPERCARRIER_ONLY + : ERTS_MMAPFLG_OS_ONLY); #endif - if (new_seg == (void *) MAP_FAILED) - new_seg = NULL; -#else -#error "Missing mseg_recreate() implementation" -#endif - } + if (MSEG_FLG_IS_2POW(flags)) + mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; + + new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep); +#ifdef ERTS_PRINT_ERTS_MMAP + erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n", + new_seg, (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua", + old_seg, old_size, req_size, *sizep); +#endif INC_CC(ma, recreate); return new_seg; } -#endif /* #if HAVE_MSEG_RECREATE */ - #ifdef DEBUG #define ERTS_DBG_MA_CHK_THR_ACCESS(MA) \ do { \ @@ -566,14 +446,19 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui return 1; } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) { - + void *destr_seg; + UWord destr_size; /* No free slots. * Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */ c = erts_circleq_tail(&(mk->cache_unpowered_node)); erts_circleq_remove(c); - mseg_destroy(mk->ma, mk, c->seg, c->size); + destr_seg = c->seg; + destr_size = c->size; + mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, &destr_seg, &destr_size); + ASSERT(destr_seg == c->seg); + ASSERT(destr_size == c->size); mseg_cache_clear_node(c); c->seg = seg; @@ -593,13 +478,20 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui int i; for( i = 0; i < CACHE_AREAS; i++) { + void *destr_seg; + UWord destr_size; if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) continue; c = erts_circleq_tail(&(mk->cache_powered_node[i])); erts_circleq_remove(c); - mseg_destroy(mk->ma, mk, c->seg, c->size); + destr_seg = seg; + destr_size = c->size; + mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, &destr_seg, &destr_size); + ASSERT(destr_seg == c->seg); + ASSERT(destr_size == c->size); + mseg_cache_clear_node(c); c->seg = seg; @@ -614,9 +506,9 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui return 0; } -static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags) { +static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) { - Uint size = *size_p; + Uint size = (UWord) *size_p; ERTS_DBG_MK_CHK_THR_ACCESS(mk); @@ -653,7 +545,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags ASSERT(!(mk->cache_size < 0)); if (csize != size) { - mseg_destroy(mk->ma, mk, (char *)seg + size, csize - size); + void *destr_seg = ((char *) seg) + size; + UWord destr_size = csize - size; + mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, &destr_seg, &destr_size); + *size_p = (UWord) (destr_seg - seg); + ASSERT(c->seg + c->size == destr_seg + destr_size); } return seg; @@ -683,7 +579,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); - *size_p = csize; + *size_p = (UWord) csize; return seg; @@ -714,7 +610,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags ASSERT((size % GET_PAGE_SIZE) == 0); ASSERT((best->size % GET_PAGE_SIZE) == 0); - *size_p = size; + *size_p = (UWord) size; return seg; @@ -728,7 +624,9 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p, Uint flags * using callbacks from aux-work in the scheduler. */ -static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { + void *destr_seg; + UWord destr_size; cache_t *c = NULL; c = erts_circleq_tail(head); @@ -737,7 +635,11 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *h if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, mk, c->seg, c->size); + destr_seg = c->seg; + destr_size = c->size; + mseg_destroy(mk->ma, flags, mk, &destr_seg, &destr_size); + ASSERT(destr_seg == c->seg); + ASSERT(destr_size == c->size); mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); @@ -749,10 +651,12 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t *h return mk->cache_size; } -static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t *head) { +static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { cache_t *c = NULL; while (!erts_circleq_is_empty(head)) { + void *destr_seg; + UWord destr_size; c = erts_circleq_tail(head); erts_circleq_remove(c); @@ -760,7 +664,11 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t *head) if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - mseg_destroy(mk->ma, mk, c->seg, c->size); + destr_seg = c->seg; + destr_size = c->size; + mseg_destroy(mk->ma, flags, mk, &destr_seg, &destr_size); + ASSERT(destr_seg == c->seg); + ASSERT(destr_size == c->size); mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); @@ -788,11 +696,11 @@ static Uint mseg_check_memkind_cache(MemKind *mk) { for (i = 0; i < CACHE_AREAS; i++) { if (!erts_circleq_is_empty(&(mk->cache_powered_node[i]))) - return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_powered_node[i])); + return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); } if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_unpowered_node)); + return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); return 0; } @@ -851,12 +759,12 @@ static void mseg_clear_memkind_cache(MemKind *mk) { if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) continue; - mseg_drop_memkind_cache_size(mk, &(mk->cache_powered_node[i])); + mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i])); ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i]))); } /* drop varied caches */ if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) - mseg_drop_memkind_cache_size(mk, &(mk->cache_unpowered_node)); + mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node)); ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node))); ASSERT(mk->cache_size == 0); @@ -896,36 +804,33 @@ static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, } static void * -mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p, +mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMsegOpt_t *opt) { - Uint size; + UWord size; void *seg; MemKind* mk = memkind(ma, opt); INC_CC(ma, alloc); - /* Carrier align */ - size = ALIGNED_CEILING(*size_p); - - /* Cache optim (if applicable) */ - if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(size)) + if (!MSEG_FLG_IS_2POW(flags) && !IS_2POW(size)) + size = ERTS_PAGEALIGNED_CEILING(*size_p); + else { + size = ALIGNED_CEILING(*size_p); + /* Cache optim (if applicable) */ size = ceil_2pow(size); + } -#if CAN_PARTLY_DESTROY - if (size < ma->min_seg_size) - ma->min_seg_size = size; -#endif - if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL) goto done; - if ((seg = mseg_create(ma, mk, size)) == NULL) - size = 0; + seg = mseg_create(ma, flags, mk, &size); + if (!seg) + *size_p = 0; + else { done: - *size_p = size; - if (seg) { + *size_p = size; if (erts_mtrace_enabled) erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); @@ -937,14 +842,16 @@ done: static void -mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size, +mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, Uint flags, const ErtsMsegOpt_t *opt) { + void *destr_seg; + UWord destr_size; MemKind* mk = memkind(ma, opt); ERTS_MSEG_DEALLOC_STAT(mk,size); - if (opt->cache && cache_bless_segment(mk, seg, size, flags)) { + if (opt->cache && cache_bless_segment(mk, seg, (Uint) size, flags)) { schedule_cache_check(ma); goto done; } @@ -952,7 +859,11 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size, if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(ma, mk, seg, size); + destr_seg = seg; + destr_size = size; + mseg_destroy(ma, flags, mk, &destr_seg, &destr_size); + ASSERT(destr_seg == seg); + ASSERT(destr_size == size); done: @@ -961,11 +872,11 @@ done: static void * mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, - Uint old_size, Uint *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) + UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) { MemKind* mk; void *new_seg; - Uint new_size; + UWord new_size; /* Just allocate a new segment if we didn't have one before */ if (!seg || !old_size) { @@ -985,90 +896,46 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, mk = memkind(ma, opt); new_seg = seg; - /* Carrier align */ - new_size = ALIGNED_CEILING(*new_size_p); - /* Cache optim (if applicable) */ - if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(new_size)) + if (!MSEG_FLG_IS_2POW(flags)) + new_size = ERTS_PAGEALIGNED_CEILING(*new_size_p); + else { + new_size = ALIGNED_CEILING(*new_size_p); + /* Cache optim (if applicable) */ new_size = ceil_2pow(new_size); + } - if (new_size == old_size) - ; - else if (new_size < old_size) { - Uint shrink_sz = old_size - new_size; - -#if CAN_PARTLY_DESTROY - if (new_size < ma->min_seg_size) - ma->min_seg_size = new_size; -#endif - /* +Mrsbcst */ - if (shrink_sz < opt->abs_shrink_th - && 100*shrink_sz < opt->rel_shrink_th*old_size) { - new_size = old_size; + if (new_size > old_size) { + if (opt->preserv) { + new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); + if (!new_seg) + new_size = old_size; } else { - -#if CAN_PARTLY_DESTROY - - if (erts_mtrace_enabled) - erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); - - mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz); - -#elif HAVE_MSEG_RECREATE - goto do_recreate; -#else + mseg_dealloc(ma, atype, seg, old_size, flags, opt); new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); - - ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); - if (!new_seg) - new_size = old_size; - else { - sys_memcpy(((char *) new_seg), - ((char *) seg), - MIN(new_size, old_size)); - mseg_dealloc(ma, atype, seg, old_size, flags, opt); - } -#endif + new_size = 0; } } - else { + else if (new_size < old_size) { + UWord shrink_sz = old_size - new_size; - if (!opt->preserv) { - mseg_dealloc(ma, atype, seg, old_size, flags, opt); - new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); - ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); + /* +Mrsbcst */ + if (shrink_sz < opt->abs_shrink_th + && 100*shrink_sz < opt->rel_shrink_th*old_size) { + new_size = old_size; } else { -#if HAVE_MSEG_RECREATE -#if !CAN_PARTLY_DESTROY - do_recreate: -#endif - new_seg = mseg_recreate(ma, mk, (void *) seg, old_size, new_size); - /* ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); - * will not always be aligned and it ok for now - */ - - if (erts_mtrace_enabled) - erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); + new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size); if (!new_seg) new_size = old_size; -#else - new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); - - ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); - - if (!new_seg) - new_size = old_size; - else { - sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size)); - mseg_dealloc(ma, atype, seg, old_size, flags, opt); - } -#endif } } + if (erts_mtrace_enabled) + erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); + INC_CC(ma, realloc); ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size)); @@ -1106,9 +973,7 @@ static struct { Eterm mseg_create; Eterm mseg_create_resize; Eterm mseg_destroy; -#if HAVE_MSEG_RECREATE Eterm mseg_recreate; -#endif Eterm mseg_clear_cache; Eterm mseg_check_cache; @@ -1163,9 +1028,7 @@ init_atoms(ErtsMsegAllctr_t *ma) AM_INIT(mseg_create); AM_INIT(mseg_create_resize); AM_INIT(mseg_destroy); -#if HAVE_MSEG_RECREATE AM_INIT(mseg_recreate); -#endif AM_INIT(mseg_clear_cache); AM_INIT(mseg_check_cache); @@ -1293,9 +1156,7 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp PRINT_CC(to, arg, create); PRINT_CC(to, arg, create_resize); PRINT_CC(to, arg, destroy); -#if HAVE_MSEG_RECREATE PRINT_CC(to, arg, recreate); -#endif PRINT_CC(to, arg, clear_cache); PRINT_CC(to, arg, check_cache); @@ -1316,12 +1177,10 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp bld_unstable_uint(hpp, szp, ma->calls.clear_cache.giga_no), bld_unstable_uint(hpp, szp, ma->calls.clear_cache.no)); -#if HAVE_MSEG_RECREATE add_3tup(hpp, szp, &res, am.mseg_recreate, bld_unstable_uint(hpp, szp, ma->calls.recreate.giga_no), bld_unstable_uint(hpp, szp, ma->calls.recreate.no)); -#endif add_3tup(hpp, szp, &res, am.mseg_destroy, bld_unstable_uint(hpp, szp, ma->calls.destroy.giga_no), @@ -1521,7 +1380,7 @@ erts_mseg_info(int ix, } void * -erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, Uint flags, const ErtsMsegOpt_t *opt) +erts_mseg_alloc_opt(ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *seg; @@ -1533,14 +1392,14 @@ erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, Uint flags, const ErtsMse } void * -erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p, Uint flags) +erts_mseg_alloc(ErtsAlcType_t atype, UWord *size_p, Uint flags) { return erts_mseg_alloc_opt(atype, size_p, flags, &erts_mseg_default_opt); } void erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, - Uint size, Uint flags, const ErtsMsegOpt_t *opt) + UWord size, Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); ERTS_MSEG_LOCK(ma); @@ -1550,14 +1409,14 @@ erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, } void -erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, Uint flags) +erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, UWord size, Uint flags) { erts_mseg_dealloc_opt(atype, seg, size, flags, &erts_mseg_default_opt); } void * erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, - Uint old_size, Uint *new_size_p, + UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) { @@ -1572,7 +1431,7 @@ erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, void * erts_mseg_realloc(ErtsAlcType_t atype, void *seg, - Uint old_size, Uint *new_size_p, Uint flags) + UWord old_size, UWord *new_size_p, Uint flags) { return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, flags, &erts_mseg_default_opt); @@ -1662,19 +1521,16 @@ erts_mseg_init(ErtsMsegInit_t *init) erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); -#if HAVE_MMAP && !defined(MAP_ANON) - mmap_fd = open("/dev/zero", O_RDWR); - if (mmap_fd < 0) - erl_exit(ERTS_ABORT_EXIT, "erts_mseg: unable to open /dev/zero\n"); +#if HALFWORD_HEAP + if (sizeof(void *) != 8) + erl_exit(-1,"Halfword emulator cannot be run in 32bit mode"); + + init->mmap.virtual_range.start = (char *) sbrk(0); + init->mmap.virtual_range.end = (char *) 0x100000000UL; + init->mmap.sco = 0; #endif -#if HAVE_MMAP -# if HALFWORD_HEAP - initialize_pmmap(); -# else erts_mmap_init(&init->mmap); -# endif -#endif if (!IS_2POW(GET_PAGE_SIZE)) erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE); @@ -1716,10 +1572,6 @@ erts_mseg_init(ErtsMsegInit_t *init) #endif sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls)); - -#if CAN_PARTLY_DESTROY - ma->min_seg_size = ~((Uint) 0); -#endif } } @@ -1761,7 +1613,7 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3) case 0x400: /* Have erts_mseg */ return (UWord) 1; case 0x401: - return (UWord) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0); + return (UWord) erts_mseg_alloc(ERTS_ALC_A_INVALID, (UWord *) a1, (Uint) 0); case 0x402: erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, (Uint) 0); return (UWord) 0; @@ -1769,7 +1621,7 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3) return (UWord) erts_mseg_realloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, - (Uint *) a3, + (UWord *) a3, (Uint) 0); case 0x404: erts_mseg_clear_cache(); @@ -1792,405 +1644,3 @@ erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3) } } - - -#if HALFWORD_HEAP -/* - * Very simple page oriented mmap replacer. Works in the lower - * 32 bit address range of a 64bit program. - * Implements anonymous mmap mremap and munmap with address order first fit. - * The free list is expected to be very short... - * To be used for compressed pointers in Erlang halfword emulator - * implementation. The MacOS X version is more of a toy, it's not really - * for production as the halfword erlang VM relies on Linux specific memory - * mapping tricks. - */ - -/* #define HARDDEBUG 1 */ - -#ifdef HARDDEBUG -static void dump_freelist(void) -{ - FreeBlock *p = first; - - while (p) { - fprintf(stderr, "p = %p\r\np->num = %ld\r\np->next = %p\r\n\r\n", - (void *) p, (unsigned long) p->num, (void *) p->next); - p = p->next; - } -} - -#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) \ - fprintf(stderr,"Mapping of address %p with size %ld " \ - "does not map complete pages (%s:%d)\r\n", \ - (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) - -#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) \ - fprintf(stderr,"Mapping of address %p with size %ld " \ - "is not page aligned (%s:%d)\r\n", \ - (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) - -#define HARDDEBUG_MAP_FAILED(PTR, SZ) \ - fprintf(stderr, "Could not actually map memory " \ - "at address %p with size %ld (%s:%d) ..\r\n", \ - (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) -#else -#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) do{}while(0) -#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) do{}while(0) -#define HARDDEBUG_MAP_FAILED(PTR, SZ) do{}while(0) -#endif - - -#ifdef __APPLE__ -#define MAP_ANONYMOUS MAP_ANON -#endif - -#define INIT_LOCK() do {erts_mtx_init(&pmmap_mutex, "pmmap");} while(0) - -#define TAKE_LOCK() do {erts_mtx_lock(&pmmap_mutex);} while(0) - -#define RELEASE_LOCK() do {erts_mtx_unlock(&pmmap_mutex);} while(0) - -static erts_mtx_t pmmap_mutex; /* Also needed when !USE_THREADS */ - -typedef struct _free_block { - unsigned long num; /*pages*/ - struct _free_block *next; -} FreeBlock; - -/* Protect with lock */ -static FreeBlock *first; - -static void *do_map(void *ptr, size_t sz) -{ - void *res; - - if (ALIGNED_CEILING(sz) != sz) { - HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz); - return NULL; - } - - if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) { - HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz); - return NULL; - } - -#if HAVE_MMAP - res = mmap(ptr, sz, - PROT_READ | PROT_WRITE, MAP_PRIVATE | - MAP_ANONYMOUS | MAP_FIXED, - -1 , 0); -#else -# error "Missing mmap support" -#endif - - if (res == MAP_FAILED) { - HARDDEBUG_MAP_FAILED(ptr, sz); - return NULL; - } - - return res; -} - -static int do_unmap(void *ptr, size_t sz) -{ - void *res; - - if (ALIGNED_CEILING(sz) != sz) { - HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz); - return 1; - } - - if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) { - HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz); - return 1; - } - - res = mmap(ptr, sz, - PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE | MAP_FIXED, - -1 , 0); - - if (res == MAP_FAILED) { - HARDDEBUG_MAP_FAILED(ptr, sz); - return 1; - } - - return 0; -} - -#ifdef __APPLE__ -/* - * The first 4 gig's are protected on Macos X for 64bit processes :( - * The range 0x1000000000 - 0x10FFFFFFFF is selected as an arbitrary - * value of a normally unused range... Real MMAP's will avoid - * it and all 32bit compressed pointers can be in that range... - * More expensive than on Linux where expansion of compressed - * poiters involves no masking (as they are in the first 4 gig's). - * It's also very uncertain if the MAP_NORESERVE flag really has - * any effect in MacOS X. Swap space may always be allocated... - */ -#define SET_RANGE_MIN() /* nothing */ -#define RANGE_MIN 0x1000000000UL -#define RANGE_MAX 0x1100000000UL -#define RANGE_MASK (RANGE_MIN) -#define EXTRA_MAP_FLAGS (MAP_FIXED) -#else -static size_t range_min; -#define SET_RANGE_MIN() do { range_min = (size_t) sbrk(0); } while (0) -#define RANGE_MIN range_min -#define RANGE_MAX 0x100000000UL -#define RANGE_MASK 0UL -#define EXTRA_MAP_FLAGS (0) -#endif - -static int initialize_pmmap(void) -{ - char *p,*q,*rptr; - size_t rsz; - FreeBlock *initial; - - SET_RANGE_MIN(); - if (sizeof(void *) != 8) { - erl_exit(1,"Halfword emulator cannot be run in 32bit mode"); - } - - p = (char *) RANGE_MIN; - q = (char *) RANGE_MAX; - - rsz = ALIGNED_FLOOR(q - p); - - rptr = mmap_align(NULL, (void *) p, rsz, - PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | - MAP_NORESERVE | EXTRA_MAP_FLAGS, - -1 , 0); -#ifdef HARDDEBUG - printf("p=%p, rsz = %ld, pages = %ld, got range = %p -> %p\r\n", - p, (unsigned long) rsz, (unsigned long) (rsz / MSEG_ALIGNED_SIZE), - (void *) rptr, (void*)(rptr + rsz)); -#endif - if ((UWord)(rptr + rsz) > RANGE_MAX) { - size_t rsz_trunc = RANGE_MAX - (UWord)rptr; -#ifdef HARDDEBUG - printf("Reducing mmap'ed memory from %lu to %lu Mb, reduced range = %p -> %p\r\n", - rsz/(1024*1024), rsz_trunc/(1024*1024), rptr, rptr+rsz_trunc); -#endif - munmap((void*)RANGE_MAX, rsz - rsz_trunc); - rsz = rsz_trunc; - } - if (!do_map(rptr, MSEG_ALIGNED_SIZE)) { - erl_exit(1,"Could not actually mmap first page for halfword emulator...\n"); - } - initial = (FreeBlock *) rptr; - initial->num = (rsz / MSEG_ALIGNED_SIZE); - initial->next = NULL; - first = initial; - INIT_LOCK(); - return 0; -} - -static void *pmmap(size_t size) -{ - size_t real_size = ALIGNED_CEILING(size); - size_t num_pages = real_size / MSEG_ALIGNED_SIZE; - FreeBlock **block; - FreeBlock *tail; - FreeBlock *res; - - TAKE_LOCK(); - - for (block = &first; - *block != NULL && (*block)->num < num_pages; - block = &((*block)->next)) - ; - if (!(*block)) { - RELEASE_LOCK(); - return NULL; - } - if ((*block)->num == num_pages) { - /* nice, perfect fit */ - res = *block; - *block = (*block)->next; - } else { - tail = (FreeBlock *) (((char *) ((void *) (*block))) + real_size); - if (!do_map(tail, MSEG_ALIGNED_SIZE)) { - HARDDEBUG_MAP_FAILED(tail, MSEG_ALIGNED_SIZE); - RELEASE_LOCK(); - return NULL; - } - tail->num = (*block)->num - num_pages; - tail->next = (*block)->next; - res = *block; - *block = tail; - } - - RELEASE_LOCK(); - - if (!do_map(res, real_size)) { - HARDDEBUG_MAP_FAILED(res, real_size); - return NULL; - } - - return (void *) res; -} - -static int pmunmap(void *p, size_t size) -{ - size_t real_size = ALIGNED_CEILING(size); - size_t num_pages = real_size / MSEG_ALIGNED_SIZE; - - FreeBlock *block; - FreeBlock *last; - FreeBlock *nb = (FreeBlock *) p; - - ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0); - - if (real_size > MSEG_ALIGNED_SIZE) { - if (do_unmap(((char *) p) + MSEG_ALIGNED_SIZE, real_size - MSEG_ALIGNED_SIZE)) { - return 1; - } - } - - TAKE_LOCK(); - - last = NULL; - block = first; - while(block != NULL && ((void *) block) < p) { - last = block; - block = block->next; - } - - if (block != NULL && - ((void *) block) == ((void *) (((char *) p) + real_size))) { - /* Merge new free block with following */ - nb->num = block->num + num_pages; - nb->next = block->next; - if (do_unmap(block, MSEG_ALIGNED_SIZE)) { - RELEASE_LOCK(); - return 1; - } - } else { - /* just link in */ - nb->num = num_pages; - nb->next = block; - } - if (last != NULL) { - if (p == ((void *) (((char *) last) + (last->num * MSEG_ALIGNED_SIZE)))) { - /* Merge with previous */ - last->num += nb->num; - last->next = nb->next; - if (do_unmap(nb, MSEG_ALIGNED_SIZE)) { - RELEASE_LOCK(); - return 1; - } - } else { - last->next = nb; - } - } else { - first = nb; - } - RELEASE_LOCK(); - return 0; -} - -static void *pmremap(void *old_address, size_t old_size, - size_t new_size) -{ - size_t new_real_size = ALIGNED_CEILING(new_size); - size_t new_num_pages = new_real_size / MSEG_ALIGNED_SIZE; - size_t old_real_size = ALIGNED_CEILING(old_size); - size_t old_num_pages = old_real_size / MSEG_ALIGNED_SIZE; - if (new_num_pages == old_num_pages) { - return old_address; - } else if (new_num_pages < old_num_pages) { /* Shrink */ - size_t nfb_pages = old_num_pages - new_num_pages; - size_t nfb_real_size = old_real_size - new_real_size; - void *vnfb = (void *) (((char *)old_address) + new_real_size); - FreeBlock *nfb = (FreeBlock *) vnfb; - FreeBlock **block; - TAKE_LOCK(); - for (block = &first; - *block != NULL && (*block) < nfb; - block = &((*block)->next)) - ; - if (!(*block) || - (*block) > ((FreeBlock *)(((char *) vnfb) + nfb_real_size))) { - /* Normal link in */ - if (nfb_pages > 1) { - if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE), - (nfb_pages - 1)*MSEG_ALIGNED_SIZE)) { - return NULL; - } - } - nfb->next = (*block); - nfb->num = nfb_pages; - (*block) = nfb; - } else { /* block merge */ - nfb->next = (*block)->next; - nfb->num = nfb_pages + (*block)->num; - /* unmap also the first page of the next freeblock */ - (*block) = nfb; - if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE), - nfb_pages*MSEG_ALIGNED_SIZE)) { - return NULL; - } - } - RELEASE_LOCK(); - return old_address; - } else { /* Enlarge */ - FreeBlock **block; - void *old_end = (void *) (((char *)old_address) + old_real_size); - TAKE_LOCK(); - for (block = &first; - *block != NULL && (*block) < (FreeBlock *) old_address; - block = &((*block)->next)) - ; - if ((*block) == NULL || old_end > ((void *) RANGE_MAX) || - (*block) != old_end || - (*block)->num < (new_num_pages - old_num_pages)) { - /* cannot extend */ - void *result; - RELEASE_LOCK(); - result = pmmap(new_size); - if (result == NULL) { - return NULL; - } - memcpy(result,old_address,old_size); - if (pmunmap(old_address,old_size)) { - /* Oups... */ - pmunmap(result,new_size); - return NULL; - } - return result; - } else { /* extend */ - size_t remaining_pages = (*block)->num - - (new_num_pages - old_num_pages); - if (!remaining_pages) { - void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE); - void *n = (*block)->next; - size_t x = ((*block)->num - 1) * MSEG_ALIGNED_SIZE; - if (x > 0) { - if (do_map(p,x) == NULL) { - RELEASE_LOCK(); - return NULL; - } - } - (*block) = n; - } else { - FreeBlock *nfb = (FreeBlock *) ((void *) - (((char *) old_address) + - new_real_size)); - void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE); - if (do_map(p,new_real_size - old_real_size) == NULL) { - RELEASE_LOCK(); - return NULL; - } - nfb->num = remaining_pages; - nfb->next = (*block)->next; - (*block) = nfb; - } - RELEASE_LOCK(); - return old_address; - } - } -} -#endif /* HALFWORD_HEAP */ diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 7454e5c473..2284b3f8f1 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -24,14 +24,14 @@ #include "erl_alloc_types.h" #include "erl_mmap.h" -#ifndef HAVE_MMAP -# define HAVE_MMAP 0 -#endif -#ifndef HAVE_MREMAP -# define HAVE_MREMAP 0 -#endif - -#if HAVE_MMAP +/* + * We currently only enable mseg_alloc if we got + * a genuine mmap()/munmap() primitive. It is possible + * to utilize erts_mmap() withiout a mmap support but + * alloc_util needs to be prepared before we can do + * that. + */ +#ifdef ERTS_HAVE_GENUINE_OS_MMAP # define HAVE_ERTS_MSEG 1 # define ERTS_HAVE_MSEG_SUPER_ALIGNED 1 #else @@ -40,8 +40,7 @@ #endif #if ERTS_HAVE_MSEG_SUPER_ALIGNED -# define MSEG_ALIGN_BITS (18) - /* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */ +# define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS #else /* If we don't use super aligned multiblock carriers * we will mmap with page size alignment (and thus use corresponding @@ -77,7 +76,8 @@ typedef struct { 4*1024*1024, /* amcbf: Absolute max cache bad fit */ \ 20, /* rmcbf: Relative max cache bad fit */ \ 10, /* mcs: Max cache size */ \ - 1000 /* cci: Cache check interval */ \ + 1000, /* cci: Cache check interval */ \ + ERTS_MMAP_INIT_DEFAULT_INITER \ } typedef struct { @@ -93,12 +93,12 @@ typedef struct { extern const ErtsMsegOpt_t erts_mseg_default_opt; -void *erts_mseg_alloc(ErtsAlcType_t, Uint *, Uint); -void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, Uint, const ErtsMsegOpt_t *); -void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint, Uint); -void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, Uint, const ErtsMsegOpt_t *); -void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *, Uint); -void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, Uint, const ErtsMsegOpt_t *); +void *erts_mseg_alloc(ErtsAlcType_t, UWord *, Uint); +void *erts_mseg_alloc_opt(ErtsAlcType_t, UWord *, Uint, const ErtsMsegOpt_t *); +void erts_mseg_dealloc(ErtsAlcType_t, void *, UWord, Uint); +void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, UWord, Uint, const ErtsMsegOpt_t *); +void *erts_mseg_realloc(ErtsAlcType_t, void *, UWord, UWord *, Uint); +void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, UWord, UWord *, Uint, const ErtsMsegOpt_t *); void erts_mseg_clear_cache(void); void erts_mseg_cache_check(void); Uint erts_mseg_no( const ErtsMsegOpt_t *); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 1e01c5bc20..c9908caf20 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -112,6 +112,7 @@ static char *plusM_other_switches[] = { "Mscs", "Mscmgc", "Msco", + "Mscrpm", "Ye", "Ym", "Ytp", -- cgit v1.2.3 From 5e4a2c0cd69736ee1b1f54f8bb63a68688bc84e8 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 2 Sep 2013 15:30:02 +0200 Subject: erts: Save one word in ErtsFreeSegDesc by putting red/black color bit in 'parent' pointer --- erts/emulator/sys/common/erl_mmap.c | 298 +++++++++++++++++++----------------- 1 file changed, 155 insertions(+), 143 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index aac01bf93c..cd71127ce5 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -83,16 +83,43 @@ UWord erts_page_inv_mask; typedef struct RBTNode_ RBTNode; struct RBTNode_ { - RBTNode *parent; + UWord parent_and_color; /* color in bit 0 of parent ptr */ RBTNode *left; RBTNode *right; +#ifdef HARD_DEBUG int flags; +#endif }; +#define RED_FLG (1) +#define IS_RED(N) ((N) && ((N)->parent_and_color & RED_FLG)) +#define IS_BLACK(N) (!IS_RED(N)) +#define SET_RED(N) ((N)->parent_and_color |= RED_FLG) +#define SET_BLACK(N) ((N)->parent_and_color &= ~RED_FLG) + +static ERTS_INLINE RBTNode* parent(RBTNode* node) +{ + return (RBTNode*) (node->parent_and_color & ~RED_FLG); +} + +static ERTS_INLINE void set_parent(RBTNode* node, RBTNode* parent) +{ + RBT_ASSERT(!((UWord)parent & RED_FLG)); + node->parent_and_color = ((UWord)parent) | (node->parent_and_color & RED_FLG); +} + +static ERTS_INLINE UWord parent_and_color(RBTNode* parent, int color) +{ + RBT_ASSERT(!((UWord)parent & RED_FLG)); + RBT_ASSERT(!(color & ~RED_FLG)); + return ((UWord)parent) | color; +} + + enum SortOrder { - ADDR_ORDER, - SZ_ADDR_ORDER, - SZ_REVERSE_ADDR_ORDER + ADDR_ORDER, /* only address order */ + SZ_ADDR_ORDER, /* first size then address order as tiebreaker */ + SZ_REVERSE_ADDR_ORDER /* first size then reverse address order */ }; typedef struct { @@ -100,13 +127,6 @@ typedef struct { enum SortOrder order; }RBTree; -#define RED_FLG (1) -#define IS_RED(N) ((N) && ((N)->flags & RED_FLG)) -#define IS_BLACK(N) (!IS_RED(N)) -#define SET_RED(N) ((N)->flags |= RED_FLG) -#define SET_BLACK(N) ((N)->flags &= ~RED_FLG) - -/* #define HARD_DEBUG */ #ifdef HARD_DEBUG # define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE) # define HARD_CHECK_TREE(TREE,SZ) check_tree(TREE, SZ) @@ -318,20 +338,20 @@ left_rotate(RBTNode **root, RBTNode *x) RBTNode *y = x->right; x->right = y->left; if (y->left) - y->left->parent = x; - y->parent = x->parent; - if (!y->parent) { + set_parent(y->left, x); + set_parent(y, parent(x)); + if (!parent(y)) { RBT_ASSERT(*root == x); *root = y; } - else if (x == x->parent->left) - x->parent->left = y; + else if (x == parent(x)->left) + parent(x)->left = y; else { - RBT_ASSERT(x == x->parent->right); - x->parent->right = y; + RBT_ASSERT(x == parent(x)->right); + parent(x)->right = y; } y->left = x; - x->parent = y; + set_parent(x, y); /*SVERK y->max_sz = x->max_sz; x->max_sz = node_max_size(x); @@ -344,20 +364,20 @@ right_rotate(RBTNode **root, RBTNode *x) RBTNode *y = x->left; x->left = y->right; if (y->right) - y->right->parent = x; - y->parent = x->parent; - if (!y->parent) { + set_parent(y->right, x); + set_parent(y, parent(x)); + if (!parent(y)) { RBT_ASSERT(*root == x); *root = y; } - else if (x == x->parent->right) - x->parent->right = y; + else if (x == parent(x)->right) + parent(x)->right = y; else { - RBT_ASSERT(x == x->parent->left); - x->parent->left = y; + RBT_ASSERT(x == parent(x)->left); + parent(x)->left = y; } y->right = x; - x->parent = y; + set_parent(x, y); /*SVERK y->max_sz = x->max_sz; x->max_sz = node_max_size(x); ASSERT(y->max_sz >= x->max_sz);*/ @@ -371,27 +391,27 @@ static ERTS_INLINE void replace(RBTNode **root, RBTNode *x, RBTNode *y) { - if (!x->parent) { + if (!parent(x)) { RBT_ASSERT(*root == x); *root = y; } - else if (x == x->parent->left) - x->parent->left = y; + else if (x == parent(x)->left) + parent(x)->left = y; else { - RBT_ASSERT(x == x->parent->right); - x->parent->right = y; + RBT_ASSERT(x == parent(x)->right); + parent(x)->right = y; } if (x->left) { - RBT_ASSERT(x->left->parent == x); - x->left->parent = y; + RBT_ASSERT(parent(x->left) == x); + set_parent(x->left, y); } if (x->right) { - RBT_ASSERT(x->right->parent == x); - x->right->parent = y; + RBT_ASSERT(parent(x->right) == x); + set_parent(x->right, y); } - y->flags = x->flags; - y->parent = x->parent; + /*y->flags = x->flags;*/ + y->parent_and_color = x->parent_and_color; y->right = x->right; y->left = x->left; /*SVERK y->max_sz = x->max_sz;*/ @@ -406,7 +426,7 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) * Rearrange the tree so that it satisfies the Red-Black Tree properties */ - RBT_ASSERT(x != *root && IS_RED(x->parent)); + RBT_ASSERT(x != *root && IS_RED(parent(x))); do { /* @@ -415,77 +435,77 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) */ RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_BLACK(x->parent->parent)); - RBT_ASSERT(x->parent->parent); + RBT_ASSERT(IS_BLACK(parent(parent(x)))); + RBT_ASSERT(parent(parent(x))); - if (x->parent == x->parent->parent->left) { - y = x->parent->parent->right; + if (parent(x) == parent(parent(x))->left) { + y = parent(parent(x))->right; if (IS_RED(y)) { SET_BLACK(y); - x = x->parent; + x = parent(x); SET_BLACK(x); - x = x->parent; + x = parent(x); SET_RED(x); } else { - if (x == x->parent->right) { - x = x->parent; + if (x == parent(x)->right) { + x = parent(x); left_rotate(root, x); } - RBT_ASSERT(x == x->parent->parent->left->left); + RBT_ASSERT(x == parent(parent(x))->left->left); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(x->parent)); - RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_RED(parent(x))); + RBT_ASSERT(IS_BLACK(parent(parent(x)))); RBT_ASSERT(IS_BLACK(y)); - SET_BLACK(x->parent); - SET_RED(x->parent->parent); - right_rotate(root, x->parent->parent); + SET_BLACK(parent(x)); + SET_RED(parent(parent(x))); + right_rotate(root, parent(parent(x))); - RBT_ASSERT(x == x->parent->left); + RBT_ASSERT(x == parent(x)->left); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(x->parent->right)); - RBT_ASSERT(IS_BLACK(x->parent)); + RBT_ASSERT(IS_RED(parent(x)->right)); + RBT_ASSERT(IS_BLACK(parent(x))); break; } } else { - RBT_ASSERT(x->parent == x->parent->parent->right); - y = x->parent->parent->left; + RBT_ASSERT(parent(x) == parent(parent(x))->right); + y = parent(parent(x))->left; if (IS_RED(y)) { SET_BLACK(y); - x = x->parent; + x = parent(x); SET_BLACK(x); - x = x->parent; + x = parent(x); SET_RED(x); } else { - if (x == x->parent->left) { - x = x->parent; + if (x == parent(x)->left) { + x = parent(x); right_rotate(root, x); } - RBT_ASSERT(x == x->parent->parent->right->right); + RBT_ASSERT(x == parent(parent(x))->right->right); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(x->parent)); - RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_RED(parent(x))); + RBT_ASSERT(IS_BLACK(parent(parent(x)))); RBT_ASSERT(IS_BLACK(y)); - SET_BLACK(x->parent); - SET_RED(x->parent->parent); - left_rotate(root, x->parent->parent); + SET_BLACK(parent(x)); + SET_RED(parent(parent(x))); + left_rotate(root, parent(parent(x))); - RBT_ASSERT(x == x->parent->right); + RBT_ASSERT(x == parent(x)->right); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(x->parent->left)); - RBT_ASSERT(IS_BLACK(x->parent)); + RBT_ASSERT(IS_RED(parent(x)->left)); + RBT_ASSERT(IS_BLACK(parent(x))); break; } } - } while (x != *root && IS_RED(x->parent)); + } while (x != *root && IS_RED(parent(x))); SET_BLACK(*root); } @@ -500,7 +520,7 @@ rbt_delete(RBTNode** root, RBTNode* del) HARD_CHECK_IS_MEMBER(*root, del); - null_x.parent = NULL; + null_x.parent_and_color = parent_and_color(NULL, !RED_FLG); /* Remove node from tree... */ @@ -514,29 +534,29 @@ rbt_delete(RBTNode** root, RBTNode* del) x = y->left ? y->left : y->right; spliced_is_black = IS_BLACK(y); if (x) { - x->parent = y->parent; + set_parent(x, parent(y)); } else if (spliced_is_black) { x = &null_x; - x->flags = 0; - SET_BLACK(x); + /*x->flags = 0; + SET_BLACK(x);*/ x->right = x->left = NULL; /*SVERK x->max_sz = 0;*/ - x->parent = y->parent; + x->parent_and_color = parent_and_color(parent(y), !RED_FLG); y->left = x; } - if (!y->parent) { + if (!parent(y)) { RBT_ASSERT(*root == y); *root = x; } else { - if (y == y->parent->left) { - y->parent->left = x; + if (y == parent(y)->left) { + parent(y)->left = x; } else { - RBT_ASSERT(y == y->parent->right); - y->parent->right = x; + RBT_ASSERT(y == parent(y)->right); + parent(y)->right = x; } /*SVERK if (y->parent != z) { lower_max_size(y->parent, (y==z ? NULL : z)); @@ -553,7 +573,7 @@ rbt_delete(RBTNode** root, RBTNode* del) /* We removed a black node which makes the resulting tree violate the Red-Black Tree properties. Fixup tree... */ - while (IS_BLACK(x) && x->parent) { + while (IS_BLACK(x) && parent(x)) { /* * x has an "extra black" which we move up the tree @@ -562,78 +582,78 @@ rbt_delete(RBTNode** root, RBTNode* del) * y is the sibbling of x */ - if (x == x->parent->left) { - y = x->parent->right; + if (x == parent(x)->left) { + y = parent(x)->right; RBT_ASSERT(y); if (IS_RED(y)) { RBT_ASSERT(y->right); RBT_ASSERT(y->left); SET_BLACK(y); - RBT_ASSERT(IS_BLACK(x->parent)); - SET_RED(x->parent); - left_rotate(root, x->parent); - y = x->parent->right; + RBT_ASSERT(IS_BLACK(parent(x))); + SET_RED(parent(x)); + left_rotate(root, parent(x)); + y = parent(x)->right; } RBT_ASSERT(y); RBT_ASSERT(IS_BLACK(y)); if (IS_BLACK(y->left) && IS_BLACK(y->right)) { SET_RED(y); - x = x->parent; + x = parent(x); } else { if (IS_BLACK(y->right)) { SET_BLACK(y->left); SET_RED(y); right_rotate(root, y); - y = x->parent->right; + y = parent(x)->right; } RBT_ASSERT(y); - if (IS_RED(x->parent)) { + if (IS_RED(parent(x))) { - SET_BLACK(x->parent); + SET_BLACK(parent(x)); SET_RED(y); } RBT_ASSERT(y->right); SET_BLACK(y->right); - left_rotate(root, x->parent); + left_rotate(root, parent(x)); x = *root; break; } } else { - RBT_ASSERT(x == x->parent->right); - y = x->parent->left; + RBT_ASSERT(x == parent(x)->right); + y = parent(x)->left; RBT_ASSERT(y); if (IS_RED(y)) { RBT_ASSERT(y->right); RBT_ASSERT(y->left); SET_BLACK(y); - RBT_ASSERT(IS_BLACK(x->parent)); - SET_RED(x->parent); - right_rotate(root, x->parent); - y = x->parent->left; + RBT_ASSERT(IS_BLACK(parent(x))); + SET_RED(parent(x)); + right_rotate(root, parent(x)); + y = parent(x)->left; } RBT_ASSERT(y); RBT_ASSERT(IS_BLACK(y)); if (IS_BLACK(y->right) && IS_BLACK(y->left)) { SET_RED(y); - x = x->parent; + x = parent(x); } else { if (IS_BLACK(y->left)) { SET_BLACK(y->right); SET_RED(y); left_rotate(root, y); - y = x->parent->left; + y = parent(x)->left; } RBT_ASSERT(y); - if (IS_RED(x->parent)) { - SET_BLACK(x->parent); + if (IS_RED(parent(x))) { + SET_BLACK(parent(x)); SET_RED(y); } RBT_ASSERT(y->left); SET_BLACK(y->left); - right_rotate(root, x->parent); + right_rotate(root, parent(x)); x = *root; break; } @@ -641,12 +661,12 @@ rbt_delete(RBTNode** root, RBTNode* del) } SET_BLACK(x); - if (null_x.parent) { - if (null_x.parent->left == &null_x) - null_x.parent->left = NULL; + if (parent(&null_x)) { + if (parent(&null_x)->left == &null_x) + parent(&null_x)->left = NULL; else { - RBT_ASSERT(null_x.parent->right == &null_x); - null_x.parent->right = NULL; + RBT_ASSERT(parent(&null_x)->right == &null_x); + parent(&null_x)->right = NULL; } RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); @@ -671,14 +691,14 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) SWord blk_sz = desc->end - desc->start; /*SVERK Uint blk_sz = AOFF_BLK_SZ(blk);*/ - blk->flags = 0; + /*blk->flags = 0;*/ blk->left = NULL; blk->right = NULL; /*SVERK blk->max_sz = blk_sz;*/ if (!*root) { - blk->parent = NULL; - SET_BLACK(blk); + blk->parent_and_color = parent_and_color(NULL, !RED_FLG); + /*SET_BLACK(blk);*/ *root = blk; } else { @@ -692,7 +712,7 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) if (diff < 0) { IF_RBT_DEBUG(dbg_over = node_to_desc(order, x)); if (!x->left) { - blk->parent = x; + blk->parent_and_color = parent_and_color(x, RED_FLG); x->left = blk; break; } @@ -702,7 +722,7 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) RBT_ASSERT(diff > 0); IF_RBT_DEBUG(dbg_under = node_to_desc(order, x)); if (!x->right) { - blk->parent = x; + blk->parent_and_color = parent_and_color(x, RED_FLG); x->right = blk; break; } @@ -723,15 +743,16 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) } /* Insert block into size tree */ - RBT_ASSERT(blk->parent); + RBT_ASSERT(parent(blk)); #ifdef RBT_DEBUG if (!order) { RBT_ASSERT(!dbg_under || dbg_under->end < desc->start); RBT_ASSERT(!dbg_over || dbg_over->start > desc->end); } #endif - SET_RED(blk); - if (IS_RED(blk->parent)) + /*SET_RED(blk);*/ + RBT_ASSERT(IS_RED(blk)); + if (IS_RED(parent(blk))) tree_insert_fixup(root, blk); } /*SVERK if (flavor == AOFF_BF) { @@ -1746,20 +1767,11 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.supercarrier = 1; erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; - - -#ifdef HARD_DEBUG - { - void test_it(void); - test_it(); } -#endif - } #if !ERTS_HAVE_OS_MMAP mmap_state.no_os_mmap = 1; #endif - } @@ -1773,9 +1785,9 @@ erts_mmap_init(ErtsMMapInit *init) static int rbt_assert_is_member(RBTNode* root, RBTNode* node) { while (node != root) { - RBT_ASSERT(node->parent); - RBT_ASSERT(node->parent->left == node || node->parent->right == node); - node = node->parent; + RBT_ASSERT(parent(node)); + RBT_ASSERT(parent(node)->left == node || parent(node)->right == node); + node = parent(node); } return 1; } @@ -1841,7 +1853,7 @@ check_tree(RBTree* tree, Uint size) x = tree->root; RBT_ASSERT(IS_BLACK(x)); - RBT_ASSERT(!x->parent); + RBT_ASSERT(!parent(x)); curr_blacks = 1; blacks = -1; depth = 1; @@ -1877,15 +1889,15 @@ check_tree(RBTree* tree, Uint size) RBT_ASSERT(IS_BLACK(x->left)); } - RBT_ASSERT(x->parent || x == tree->root); + RBT_ASSERT(parent(x) || x == tree->root); if (x->left) { - RBT_ASSERT(x->left->parent == x); + RBT_ASSERT(parent(x->left) == x); RBT_ASSERT(cmp_blocks(tree->order, x->left, x) < 0); } if (x->right) { - RBT_ASSERT(x->right->parent == x); + RBT_ASSERT(parent(x->right) == x); RBT_ASSERT(cmp_blocks(tree->order, x->right, x) > 0); } @@ -1923,7 +1935,7 @@ check_tree(RBTree* tree, Uint size) UNSET_RIGHT_VISITED(x); if (IS_BLACK(x)) curr_blacks--; - x = x->parent; + x = parent(x); --depth; } RBT_ASSERT(depth == 0 || (!tree->root && depth==1)); @@ -1937,6 +1949,8 @@ check_tree(RBTree* tree, Uint size) return res; } +#endif /* HARD_DEBUG */ + #ifdef PRINT_TREE #define INDENT_STEP 2 @@ -1983,13 +1997,13 @@ void test_it(void) init_free_seg_map(&map, i); insert_free_seg(&map, alloc_desc(), (char*)0x11000, (char*)0x12000); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); insert_free_seg(&map, alloc_desc(), (char*)0x13000, (char*)0x14000); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); insert_free_seg(&map, alloc_desc(), (char*)0x15000, (char*)0x17000); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); insert_free_seg(&map, alloc_desc(), (char*)0x8000, (char*)0x10000); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); desc = lookup_free_seg(&map, 0x500); ERTS_ASSERT(desc->start == (char*)(i?0x13000L:0x11000L)); @@ -2026,17 +2040,15 @@ void test_it(void) ERTS_ASSERT(d1->start == (char*)(i?0x13000L:0x11000L)); resize_free_seg(&map, d1, d1->start - 0x800, (char*)d1->end); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); d2 = lookup_free_seg(&map, 0x1200); ERTS_ASSERT(d2 == d1); delete_free_seg(&map, d1); - check_tree(&map.atree, 0); check_tree(&map.stree, 0); + HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); d1 = lookup_free_seg(&map, 0x1200); ERTS_ASSERT(d1->start == (char*)0x15000); } } - -#endif /* HARD_DEBUG */ -- cgit v1.2.3 From 97f11582fba9e8b141764273b94bd1ccee3d9b08 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 2 Sep 2013 16:22:32 +0200 Subject: erts: Remove HARD_DEBUG flags for tree traversal --- erts/emulator/sys/common/erl_mmap.c | 120 ++++++++++++++++-------------------- 1 file changed, 54 insertions(+), 66 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index cd71127ce5..77c6abadf9 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -86,9 +86,6 @@ struct RBTNode_ { UWord parent_and_color; /* color in bit 0 of parent ptr */ RBTNode *left; RBTNode *right; -#ifdef HARD_DEBUG - int flags; -#endif }; #define RED_FLG (1) @@ -1792,22 +1789,6 @@ static int rbt_assert_is_member(RBTNode* root, RBTNode* node) return 1; } -#define LEFT_VISITED_FLG 0x1000 -#define THIS_VISITED_FLG 0x100 -#define RIGHT_VISITED_FLG 0x10 -#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) -#define IS_THIS_VISITED(FB) ((FB)->flags & THIS_VISITED_FLG) -#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) - -#define SET_LEFT_VISITED(FB) ((FB)->flags |= LEFT_VISITED_FLG) -#define SET_THIS_VISITED(FB) ((FB)->flags |= THIS_VISITED_FLG) -#define SET_RIGHT_VISITED(FB) ((FB)->flags |= RIGHT_VISITED_FLG) - -#define UNSET_LEFT_VISITED(FB) ((FB)->flags &= ~LEFT_VISITED_FLG) -#define UNSET_THIS_VISITED(FB) ((FB)->flags &= ~THIS_VISITED_FLG) -#define UNSET_RIGHT_VISITED(FB) ((FB)->flags &= ~RIGHT_VISITED_FLG) - - #if 1 /*SVERK*/ # define PRINT_TREE @@ -1843,6 +1824,7 @@ check_tree(RBTree* tree, Uint size) Uint depth, max_depth, node_cnt; ErtsFreeSegDesc* seg = NULL; ErtsFreeSegDesc* prev_seg = NULL; + enum { RECURSE_LEFT, CHECK_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state; #ifdef PRINT_TREE print_tree(tree->order, tree->root); @@ -1859,27 +1841,29 @@ check_tree(RBTree* tree, Uint size) depth = 1; max_depth = 0; node_cnt = 0; + state = RECURSE_LEFT; /* Traverse tree in sorting order */ while (x) { - if (!IS_LEFT_VISITED(x)) { - SET_LEFT_VISITED(x); - if (x->left) { - x = x->left; - ++depth; - if (IS_BLACK(x)) - curr_blacks++; - continue; - } - else { - if (blacks < 0) - blacks = curr_blacks; - RBT_ASSERT(blacks == curr_blacks); - } - } + switch (state) { + case RECURSE_LEFT: + if (x->left) { + RBT_ASSERT(parent(x->left) == x); + x = x->left; + ++depth; + if (IS_BLACK(x)) + curr_blacks++; + state = RECURSE_LEFT; + } + else { + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + state = CHECK_NODE; + } + break; - if (!IS_THIS_VISITED(x)) { - SET_THIS_VISITED(x); + case CHECK_NODE: ++node_cnt; if (depth > max_depth) max_depth = depth; @@ -1892,12 +1876,9 @@ check_tree(RBTree* tree, Uint size) RBT_ASSERT(parent(x) || x == tree->root); if (x->left) { - RBT_ASSERT(parent(x->left) == x); RBT_ASSERT(cmp_blocks(tree->order, x->left, x) < 0); } - if (x->right) { - RBT_ASSERT(parent(x->right) == x); RBT_ASSERT(cmp_blocks(tree->order, x->right, x) > 0); } @@ -1912,40 +1893,47 @@ check_tree(RBTree* tree, Uint size) RBT_ASSERT(!prev_seg || prev_seg->end < seg->start); prev_seg = seg; } + state = RECURSE_RIGHT; + break; - } - if (!IS_RIGHT_VISITED(x)) { - SET_RIGHT_VISITED(x); - if (x->right) { - x = x->right; - ++depth; - if (IS_BLACK(x)) - curr_blacks++; - continue; - } - else { - if (blacks < 0) - blacks = curr_blacks; - RBT_ASSERT(blacks == curr_blacks); - } - } + case RECURSE_RIGHT: + if (x->right) { + RBT_ASSERT(parent(x->right) == x); + x = x->right; + ++depth; + if (IS_BLACK(x)) + curr_blacks++; + state = RECURSE_LEFT; + } + else { + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + state = RETURN_TO_PARENT; + } + break; - UNSET_LEFT_VISITED(x); - UNSET_THIS_VISITED(x); - UNSET_RIGHT_VISITED(x); - if (IS_BLACK(x)) - curr_blacks--; - x = parent(x); - --depth; + case RETURN_TO_PARENT: + if (parent(x)) { + if (x == parent(x)->left) { + state = CHECK_NODE; + } + else { + RBT_ASSERT(x == parent(x)->right); + state = RETURN_TO_PARENT; + } + } + if (IS_BLACK(x)) + curr_blacks--; + x = parent(x); + --depth; + break; + } } RBT_ASSERT(depth == 0 || (!tree->root && depth==1)); RBT_ASSERT(curr_blacks == 0); RBT_ASSERT((1 << (max_depth/2)) <= node_cnt); - UNSET_LEFT_VISITED(tree->root); - UNSET_THIS_VISITED(tree->root); - UNSET_RIGHT_VISITED(tree->root); - return res; } -- cgit v1.2.3 From 9fe8915784a23622577a8bc8604e809d34623c94 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 3 Sep 2013 11:25:36 +0200 Subject: erts: Add build_free_seg_list --- erts/emulator/sys/common/erl_mmap.c | 136 +++++++++++++++++++++++++++++++++++- 1 file changed, 135 insertions(+), 1 deletion(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 77c6abadf9..5624ec9813 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -21,9 +21,10 @@ #endif #include "sys.h" -#include +#include "erl_process.h" #include "erl_smp.h" #include "erl_mmap.h" +#include #if defined(DEBUG) || 0 # undef ERTS_MMAP_DEBUG @@ -145,6 +146,7 @@ typedef struct { typedef struct { RBTree stree; RBTree atree; + Uint nseg; }ErtsFreeSegMap; static struct { @@ -758,6 +760,96 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) }*/ } +/* + * Traverse tree in (reverse) sorting order + */ +static void +rbt_foreach_node(RBTree* tree, + void (*fn)(RBTNode*,void*), + void* arg, int reverse) +{ +#ifdef HARD_DEBUG + Sint blacks = -1; + Sint curr_blacks = 1; + Uint depth = 1; +#endif + enum { RECURSE_LEFT, DO_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state; + RBTNode *x = tree->root; + + RBT_ASSERT(!parent(x)); + + state = reverse ? RECURSE_RIGHT : RECURSE_LEFT; + while (x) { + switch (state) { + case RECURSE_LEFT: + if (x->left) { + RBT_ASSERT(parent(x->left) == x); + #ifdef HARD_DEBUG + ++depth; + if (IS_BLACK(x->left)) + curr_blacks++; + #endif + x = x->left; + state = reverse ? RECURSE_RIGHT : RECURSE_LEFT; + } + else { + #ifdef HARD_DEBUG + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + #endif + state = reverse ? RETURN_TO_PARENT : DO_NODE; + } + break; + + case DO_NODE: + (*fn) (x, arg); + state = reverse ? RECURSE_LEFT : RECURSE_RIGHT; + break; + + case RECURSE_RIGHT: + if (x->right) { + RBT_ASSERT(parent(x->right) == x); + #ifdef HARD_DEBUG + ++depth; + if (IS_BLACK(x->right)) + curr_blacks++; + #endif + x = x->right; + state = reverse ? RECURSE_RIGHT : RECURSE_LEFT; + } + else { + #ifdef HARD_DEBUG + if (blacks < 0) + blacks = curr_blacks; + RBT_ASSERT(blacks == curr_blacks); + #endif + state = reverse ? DO_NODE : RETURN_TO_PARENT; + } + break; + + case RETURN_TO_PARENT: + #ifdef HARD_DEBUG + if (IS_BLACK(x)) + curr_blacks--; + --depth; + #endif + if (parent(x)) { + if (x == parent(x)->left) { + state = reverse ? RETURN_TO_PARENT : DO_NODE; + } + else { + RBT_ASSERT(x == parent(x)->right); + state = reverse ? DO_NODE : RETURN_TO_PARENT; + } + } + x = parent(x); + break; + } + } +} + + /* The API to keep track of a bunch of separated free segments (non-overlapping and non-adjacent). @@ -777,6 +869,7 @@ static void init_free_seg_map(ErtsFreeSegMap* map, int reverse_ao) map->atree.order = ADDR_ORDER; map->stree.root = NULL; map->stree.order = reverse_ao ? SZ_REVERSE_ADDR_ORDER : SZ_ADDR_ORDER; + map->nseg = 0; } static void adjacent_free_seg(ErtsFreeSegMap* map, char* start, char* end, @@ -813,6 +906,7 @@ static void insert_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, desc->end = end; rbt_insert(map->atree.order, &map->atree.root, &desc->anode); rbt_insert(map->stree.order, &map->stree.root, &desc->snode); + map->nseg++; } static void resize_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, @@ -835,6 +929,7 @@ static void delete_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc) { rbt_delete(&map->atree.root, &desc->anode); rbt_delete(&map->stree.root, &desc->snode); + map->nseg--; } static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) @@ -857,6 +952,44 @@ static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) return best_desc; } +struct build_arg_t +{ + Process* p; + Eterm* hp; + Eterm acc; +}; + +static void build_free_seg_tuple(RBTNode* node, void* arg) +{ + struct build_arg_t* a = (struct build_arg_t*)arg; + ErtsFreeSegDesc* desc = anode_to_desc(node); + Eterm start= erts_bld_uword(&a->hp, NULL, (UWord)desc->start); + Eterm end = erts_bld_uword(&a->hp, NULL, (UWord)desc->end); + Eterm tpl = TUPLE2(a->hp, start, end); + + a->hp += 3; + a->acc = CONS(a->hp, tpl, a->acc); + a->hp += 2; +} + +static +Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) +{ + struct build_arg_t barg; + Eterm* hp_end; + const Uint may_need = map->nseg * (2 + 3 + 2*2); /* cons + tuple + bigs */ + + barg.p = p; + barg.hp = HAlloc(p, may_need); + hp_end = barg.hp + may_need; + barg.acc = NIL; + rbt_foreach_node(&map->atree, build_free_seg_tuple, &barg, 1); + + RBT_ASSERT(barg.hp <= hp_end); + HRelease(p, hp_end, barg.hp); + return barg.acc; +} + #if ERTS_HAVE_OS_MMAP /* Implementation of os_mmap()/os_munmap()/os_mremap()... */ @@ -1975,6 +2108,7 @@ print_tree(enum SortOrder order, RBTNode* root) #endif /* PRINT_TREE */ + void test_it(void) { ErtsFreeSegMap map; -- cgit v1.2.3 From 0d9c5c44a46810f0d9f45a533ca8a3754c11c643 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 3 Sep 2013 17:18:34 +0200 Subject: erts: Use rbt_foreach_node to check_tree --- erts/emulator/sys/common/erl_mmap.c | 161 +++++++++++++----------------------- 1 file changed, 58 insertions(+), 103 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 5624ec9813..2d749b2402 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -772,6 +772,8 @@ rbt_foreach_node(RBTree* tree, Sint blacks = -1; Sint curr_blacks = 1; Uint depth = 1; + Uint max_depth = 0; + Uint node_cnt = 0; #endif enum { RECURSE_LEFT, DO_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state; RBTNode *x = tree->root; @@ -803,7 +805,12 @@ rbt_foreach_node(RBTree* tree, break; case DO_NODE: - (*fn) (x, arg); + #ifdef HARD_DEBUG + ++node_cnt; + if (depth > max_depth) + max_depth = depth; + #endif + (*fn) (x, arg); /* Do it! */ state = reverse ? RECURSE_LEFT : RECURSE_RIGHT; break; @@ -847,6 +854,11 @@ rbt_foreach_node(RBTree* tree, break; } } +#ifdef HARD_DEBUG + RBT_ASSERT(depth == 0 || (!tree->root && depth==1)); + RBT_ASSERT(curr_blacks == 0); + RBT_ASSERT((1 << (max_depth/2)) <= node_cnt); +#endif } @@ -1947,127 +1959,70 @@ static void print_tree(enum SortOrder order, RBTNode*); * */ +struct check_arg_t { + RBTree* tree; + ErtsFreeSegDesc* prev_seg; + Uint size; + RBTNode *res; +}; +static void check_node(RBTNode* x, void* arg); + + static RBTNode * check_tree(RBTree* tree, Uint size) { - RBTNode *res = NULL; - Sint blacks; - Sint curr_blacks; - RBTNode *x; - Uint depth, max_depth, node_cnt; - ErtsFreeSegDesc* seg = NULL; - ErtsFreeSegDesc* prev_seg = NULL; - enum { RECURSE_LEFT, CHECK_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state; + struct check_arg_t carg; + carg.tree = tree; + carg.prev_seg = NULL; + carg.size = size; + carg.res = NULL; #ifdef PRINT_TREE print_tree(tree->order, tree->root); #endif if (!tree->root) - return res; + return NULL; - x = tree->root; - RBT_ASSERT(IS_BLACK(x)); - RBT_ASSERT(!parent(x)); - curr_blacks = 1; - blacks = -1; - depth = 1; - max_depth = 0; - node_cnt = 0; - state = RECURSE_LEFT; - - /* Traverse tree in sorting order */ - while (x) { - switch (state) { - case RECURSE_LEFT: - if (x->left) { - RBT_ASSERT(parent(x->left) == x); - x = x->left; - ++depth; - if (IS_BLACK(x)) - curr_blacks++; - state = RECURSE_LEFT; - } - else { - if (blacks < 0) - blacks = curr_blacks; - RBT_ASSERT(blacks == curr_blacks); - state = CHECK_NODE; - } - break; + RBT_ASSERT(IS_BLACK(tree->root)); + RBT_ASSERT(!parent(tree->root)); - case CHECK_NODE: - ++node_cnt; - if (depth > max_depth) - max_depth = depth; + rbt_foreach_node(tree, check_node, &carg, 0); - if (IS_RED(x)) { - RBT_ASSERT(IS_BLACK(x->right)); - RBT_ASSERT(IS_BLACK(x->left)); - } + return carg.res; +} - RBT_ASSERT(parent(x) || x == tree->root); +/* callback */ +static void check_node(RBTNode* x, void* arg) +{ + struct check_arg_t* a = (struct check_arg_t*) arg; + ErtsFreeSegDesc* seg; - if (x->left) { - RBT_ASSERT(cmp_blocks(tree->order, x->left, x) < 0); - } - if (x->right) { - RBT_ASSERT(cmp_blocks(tree->order, x->right, x) > 0); - } + if (IS_RED(x)) { + RBT_ASSERT(IS_BLACK(x->right)); + RBT_ASSERT(IS_BLACK(x->left)); + } - seg = node_to_desc(tree->order, x); - RBT_ASSERT(seg->start < seg->end); - if (size && (seg->end - seg->start) >= size) { - if (!res || cmp_blocks(tree->order, x, res) < 0) { - res = x; - } - } - if (tree->order == ADDR_ORDER) { - RBT_ASSERT(!prev_seg || prev_seg->end < seg->start); - prev_seg = seg; - } - state = RECURSE_RIGHT; - break; + RBT_ASSERT(parent(x) || x == a->tree->root); - case RECURSE_RIGHT: - if (x->right) { - RBT_ASSERT(parent(x->right) == x); - x = x->right; - ++depth; - if (IS_BLACK(x)) - curr_blacks++; - state = RECURSE_LEFT; - } - else { - if (blacks < 0) - blacks = curr_blacks; - RBT_ASSERT(blacks == curr_blacks); - state = RETURN_TO_PARENT; - } - break; + if (x->left) { + RBT_ASSERT(cmp_blocks(a->tree->order, x->left, x) < 0); + } + if (x->right) { + RBT_ASSERT(cmp_blocks(a->tree->order, x->right, x) > 0); + } - case RETURN_TO_PARENT: - if (parent(x)) { - if (x == parent(x)->left) { - state = CHECK_NODE; - } - else { - RBT_ASSERT(x == parent(x)->right); - state = RETURN_TO_PARENT; - } - } - if (IS_BLACK(x)) - curr_blacks--; - x = parent(x); - --depth; - break; + seg = node_to_desc(a->tree->order, x); + RBT_ASSERT(seg->start < seg->end); + if (a->size && (seg->end - seg->start) >= a->size) { + if (!a->res || cmp_blocks(a->tree->order, x, a->res) < 0) { + a->res = x; } } - RBT_ASSERT(depth == 0 || (!tree->root && depth==1)); - RBT_ASSERT(curr_blacks == 0); - RBT_ASSERT((1 << (max_depth/2)) <= node_cnt); - - return res; + if (a->tree->order == ADDR_ORDER) { + RBT_ASSERT(!a->prev_seg || a->prev_seg->end < seg->start); + a->prev_seg = seg; + } } #endif /* HARD_DEBUG */ -- cgit v1.2.3 From 984f0e42665e9fa09467145976183bf88f8f3da8 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 3 Sep 2013 19:54:38 +0200 Subject: erts: Optimize rb-tree operations by "caching" parent ptr --- erts/emulator/sys/common/erl_mmap.c | 152 +++++++++++++++++++----------------- 1 file changed, 81 insertions(+), 71 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 2d749b2402..ede7c66fdc 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -419,13 +419,14 @@ replace(RBTNode **root, RBTNode *x, RBTNode *y) static void tree_insert_fixup(RBTNode** root, RBTNode *blk) { - RBTNode *x = blk, *y; + RBTNode *x = blk, *y, *papa_x, *granpa_x; /* * Rearrange the tree so that it satisfies the Red-Black Tree properties */ - RBT_ASSERT(x != *root && IS_RED(parent(x))); + papa_x = parent(x); + RBT_ASSERT(x != *root && IS_RED(papa_x)); do { /* @@ -433,35 +434,36 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) * until we get to the root or until we can separate them. */ + granpa_x = parent(papa_x); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_BLACK(parent(parent(x)))); - RBT_ASSERT(parent(parent(x))); + RBT_ASSERT(IS_BLACK(granpa_x)); + RBT_ASSERT(granpa_x); - if (parent(x) == parent(parent(x))->left) { - y = parent(parent(x))->right; + if (papa_x == granpa_x->left) { + y = granpa_x->right; if (IS_RED(y)) { SET_BLACK(y); - x = parent(x); - SET_BLACK(x); - x = parent(x); - SET_RED(x); + SET_BLACK(papa_x); + SET_RED(granpa_x); + x = granpa_x; } else { - if (x == parent(x)->right) { - x = parent(x); - left_rotate(root, x); + if (x == papa_x->right) { + left_rotate(root, papa_x); + papa_x = x; + x = papa_x->left; } - RBT_ASSERT(x == parent(parent(x))->left->left); + RBT_ASSERT(x == granpa_x->left->left); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(parent(x))); - RBT_ASSERT(IS_BLACK(parent(parent(x)))); + RBT_ASSERT(IS_RED(papa_x)); + RBT_ASSERT(IS_BLACK(granpa_x)); RBT_ASSERT(IS_BLACK(y)); - SET_BLACK(parent(x)); - SET_RED(parent(parent(x))); - right_rotate(root, parent(parent(x))); + SET_BLACK(papa_x); + SET_RED(granpa_x); + right_rotate(root, granpa_x); RBT_ASSERT(x == parent(x)->left); RBT_ASSERT(IS_RED(x)); @@ -471,31 +473,31 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) } } else { - RBT_ASSERT(parent(x) == parent(parent(x))->right); - y = parent(parent(x))->left; + RBT_ASSERT(papa_x == granpa_x->right); + y = granpa_x->left; if (IS_RED(y)) { SET_BLACK(y); - x = parent(x); - SET_BLACK(x); - x = parent(x); - SET_RED(x); + SET_BLACK(papa_x); + SET_RED(granpa_x); + x = granpa_x; } else { - if (x == parent(x)->left) { - x = parent(x); - right_rotate(root, x); + if (x == papa_x->left) { + right_rotate(root, papa_x); + papa_x = x; + x = papa_x->right; } - RBT_ASSERT(x == parent(parent(x))->right->right); + RBT_ASSERT(x == granpa_x->right->right); RBT_ASSERT(IS_RED(x)); - RBT_ASSERT(IS_RED(parent(x))); - RBT_ASSERT(IS_BLACK(parent(parent(x)))); + RBT_ASSERT(IS_RED(papa_x)); + RBT_ASSERT(IS_BLACK(granpa_x)); RBT_ASSERT(IS_BLACK(y)); - SET_BLACK(parent(x)); - SET_RED(parent(parent(x))); - left_rotate(root, parent(parent(x))); + SET_BLACK(papa_x); + SET_RED(granpa_x); + left_rotate(root, granpa_x); RBT_ASSERT(x == parent(x)->right); RBT_ASSERT(IS_RED(x)); @@ -504,7 +506,7 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) break; } } - } while (x != *root && IS_RED(parent(x))); + } while (x != *root && (papa_x=parent(x), IS_RED(papa_x))); SET_BLACK(*root); } @@ -513,7 +515,7 @@ static void rbt_delete(RBTNode** root, RBTNode* del) { Uint spliced_is_black; - RBTNode *x, *y, *z = del; + RBTNode *x, *y, *z = del, *papa_y; RBTNode null_x; /* null_x is used to get the fixup started when we splice out a node without children. */ @@ -532,8 +534,9 @@ rbt_delete(RBTNode** root, RBTNode* del) /* splice out y */ x = y->left ? y->left : y->right; spliced_is_black = IS_BLACK(y); + papa_y = parent(y); if (x) { - set_parent(x, parent(y)); + set_parent(x, papa_y); } else if (spliced_is_black) { x = &null_x; @@ -541,21 +544,21 @@ rbt_delete(RBTNode** root, RBTNode* del) SET_BLACK(x);*/ x->right = x->left = NULL; /*SVERK x->max_sz = 0;*/ - x->parent_and_color = parent_and_color(parent(y), !RED_FLG); + x->parent_and_color = parent_and_color(papa_y, !RED_FLG); y->left = x; } - if (!parent(y)) { + if (!papa_y) { RBT_ASSERT(*root == y); *root = x; } else { - if (y == parent(y)->left) { - parent(y)->left = x; + if (y == papa_y->left) { + papa_y->left = x; } else { - RBT_ASSERT(y == parent(y)->right); - parent(y)->right = x; + RBT_ASSERT(y == papa_y->right); + papa_y->right = x; } /*SVERK if (y->parent != z) { lower_max_size(y->parent, (y==z ? NULL : z)); @@ -569,10 +572,12 @@ rbt_delete(RBTNode** root, RBTNode* del) } if (spliced_is_black) { + RBTNode* papa_x; /* We removed a black node which makes the resulting tree violate the Red-Black Tree properties. Fixup tree... */ - while (IS_BLACK(x) && parent(x)) { + papa_x = parent(x); + while (IS_BLACK(x) && papa_x) { /* * x has an "extra black" which we move up the tree @@ -581,91 +586,96 @@ rbt_delete(RBTNode** root, RBTNode* del) * y is the sibbling of x */ - if (x == parent(x)->left) { - y = parent(x)->right; + if (x == papa_x->left) { + y = papa_x->right; RBT_ASSERT(y); if (IS_RED(y)) { RBT_ASSERT(y->right); RBT_ASSERT(y->left); SET_BLACK(y); - RBT_ASSERT(IS_BLACK(parent(x))); - SET_RED(parent(x)); - left_rotate(root, parent(x)); - y = parent(x)->right; + RBT_ASSERT(IS_BLACK(papa_x)); + SET_RED(papa_x); + left_rotate(root, papa_x); + RBT_ASSERT(papa_x == parent(x)); + y = papa_x->right; } RBT_ASSERT(y); RBT_ASSERT(IS_BLACK(y)); if (IS_BLACK(y->left) && IS_BLACK(y->right)) { SET_RED(y); - x = parent(x); } else { if (IS_BLACK(y->right)) { SET_BLACK(y->left); SET_RED(y); right_rotate(root, y); - y = parent(x)->right; + RBT_ASSERT(papa_x == parent(x)); + y = papa_x->right; } RBT_ASSERT(y); - if (IS_RED(parent(x))) { + if (IS_RED(papa_x)) { - SET_BLACK(parent(x)); + SET_BLACK(papa_x); SET_RED(y); } RBT_ASSERT(y->right); SET_BLACK(y->right); - left_rotate(root, parent(x)); + left_rotate(root, papa_x); x = *root; break; } } else { - RBT_ASSERT(x == parent(x)->right); - y = parent(x)->left; + RBT_ASSERT(x == papa_x->right); + y = papa_x->left; RBT_ASSERT(y); if (IS_RED(y)) { RBT_ASSERT(y->right); RBT_ASSERT(y->left); SET_BLACK(y); - RBT_ASSERT(IS_BLACK(parent(x))); - SET_RED(parent(x)); - right_rotate(root, parent(x)); - y = parent(x)->left; + RBT_ASSERT(IS_BLACK(papa_x)); + SET_RED(papa_x); + right_rotate(root, papa_x); + RBT_ASSERT(papa_x == parent(x)); + y = papa_x->left; } RBT_ASSERT(y); RBT_ASSERT(IS_BLACK(y)); if (IS_BLACK(y->right) && IS_BLACK(y->left)) { SET_RED(y); - x = parent(x); } else { if (IS_BLACK(y->left)) { SET_BLACK(y->right); SET_RED(y); left_rotate(root, y); - y = parent(x)->left; + RBT_ASSERT(papa_x == parent(x)); + y = papa_x->left; } RBT_ASSERT(y); - if (IS_RED(parent(x))) { - SET_BLACK(parent(x)); + if (IS_RED(papa_x)) { + SET_BLACK(papa_x); SET_RED(y); } RBT_ASSERT(y->left); SET_BLACK(y->left); - right_rotate(root, parent(x)); + right_rotate(root, papa_x); x = *root; break; } } + x = papa_x; + papa_x = parent(x); } SET_BLACK(x); - if (parent(&null_x)) { - if (parent(&null_x)->left == &null_x) - parent(&null_x)->left = NULL; + papa_x = parent(&null_x); + if (papa_x) { + if (papa_x->left == &null_x) + papa_x->left = NULL; else { - RBT_ASSERT(parent(&null_x)->right == &null_x); - parent(&null_x)->right = NULL; + RBT_ASSERT(papa_x->right == &null_x); + papa_x->right = NULL; } RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); -- cgit v1.2.3 From e0e17136506f9c8363b46a991012422980925dd1 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 4 Sep 2013 14:56:49 +0200 Subject: erts: Add __func__ to ERTS_ASSERT macro --- erts/emulator/beam/sys.h | 4 ++-- erts/emulator/sys/common/erl_mmap.c | 13 +------------ erts/emulator/sys/unix/sys.c | 6 +++--- erts/emulator/sys/win32/sys.c | 2 +- 4 files changed, 7 insertions(+), 18 deletions(-) diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index dfe60d8ea0..9561c0be96 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -150,8 +150,8 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; #endif #define ERTS_ASSERT(e) \ - ((void) ((e) ? 1 : (erl_assert_error(#e, __FILE__, __LINE__), 0))) -void erl_assert_error(char* expr, char* file, int line); + ((void) ((e) ? 1 : (erl_assert_error(#e, __func__, __FILE__, __LINE__), 0))) +void erl_assert_error(const char* expr, const char *func, const char* file, int line); #ifdef DEBUG # define ASSERT(e) ERTS_ASSERT(e) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index ede7c66fdc..58795bd3a6 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -34,18 +34,7 @@ /* #define ERTS_MMAP_DEBUG_FILL_AREAS */ #ifdef ERTS_MMAP_DEBUG -# define ERTS_MMAP_ASSERT(A) \ - ((void) (!(A) \ - ? erts_mmap_assert_failed(#A, __func__, __FILE__, __LINE__)\ - : 1)) -static int -erts_mmap_assert_failed(const char *a, const char *func, const char *file, int line) -{ - erts_fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", - (char *) file, line, (char *) func, (char *) a); - abort(); - return 0; -} +# define ERTS_MMAP_ASSERT ERTS_ASSERT #else # define ERTS_MMAP_ASSERT(A) ((void) 1) #endif diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 47991756df..401b37b9d2 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -2640,11 +2640,11 @@ int fd; extern int erts_initialized; void -erl_assert_error(char* expr, char* file, int line) +erl_assert_error(const char* expr, const char* func, const char* file, int line) { fflush(stdout); - fprintf(stderr, "Assertion failed: %s in %s, line %d\n", - expr, file, line); + fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n", + file, line, func, expr); fflush(stderr); #if !defined(ERTS_SMP) && 0 /* Writing a crashdump from a failed assertion when smp support diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 6a1d6b08f4..99951bb45e 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3224,7 +3224,7 @@ erl_bin_write(buf, sz, max) } void -erl_assert_error(char* expr, char* file, int line) +erl_assert_error(const char* expr, const char* func, const char* file, int line) { char message[1024]; -- cgit v1.2.3 From 5295a138518df6c9f4907a2fb9afb1282b96ffb7 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 4 Sep 2013 15:00:30 +0200 Subject: erts: Cleanup erl_mmap --- erts/emulator/sys/common/erl_mmap.c | 233 +++++++++++++++++++----------------- 1 file changed, 121 insertions(+), 112 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 58795bd3a6..723efa772f 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -126,15 +126,15 @@ static RBTNode* check_tree(RBTree* tree, Uint); typedef struct { - RBTNode snode; - RBTNode anode; + RBTNode snode; /* node in 'stree' */ + RBTNode anode; /* node in 'atree' */ char* start; char* end; }ErtsFreeSegDesc; typedef struct { - RBTree stree; - RBTree atree; + RBTree stree; /* size ordered tree */ + RBTree atree; /* address ordered tree */ Uint nseg; }ErtsFreeSegMap; @@ -277,8 +277,8 @@ static ERTS_INLINE ErtsFreeSegDesc* node_to_desc(enum SortOrder order, RBTNode* } #ifdef HARD_DEBUG -static ERTS_INLINE SWord cmp_blocks(enum SortOrder order, - RBTNode* lhs, RBTNode* rhs) +static ERTS_INLINE SWord cmp_nodes(enum SortOrder order, + RBTNode* lhs, RBTNode* rhs) { ErtsFreeSegDesc* ldesc = node_to_desc(order, lhs); ErtsFreeSegDesc* rdesc = node_to_desc(order, rhs); @@ -296,10 +296,10 @@ static ERTS_INLINE SWord cmp_blocks(enum SortOrder order, return (char*)rdesc->start - (char*)ldesc->start; } } -#endif +#endif /* HARD_DEBUG */ -static ERTS_INLINE SWord cmp_with_block(enum SortOrder order, - SWord sz, char* addr, RBTNode* rhs) +static ERTS_INLINE SWord cmp_with_node(enum SortOrder order, + SWord sz, char* addr, RBTNode* rhs) { ErtsFreeSegDesc* rdesc; if (order != ADDR_ORDER) { @@ -340,10 +340,6 @@ left_rotate(RBTNode **root, RBTNode *x) } y->left = x; set_parent(x, y); - - /*SVERK y->max_sz = x->max_sz; - x->max_sz = node_max_size(x); - ASSERT(y->max_sz >= x->max_sz);*/ } static ERTS_INLINE void @@ -366,14 +362,11 @@ right_rotate(RBTNode **root, RBTNode *x) } y->right = x; set_parent(x, y); - /*SVERK y->max_sz = x->max_sz; - x->max_sz = node_max_size(x); - ASSERT(y->max_sz >= x->max_sz);*/ } /* * Replace node x with node y - * NOTE: block header of y is not changed + * NOTE: segment descriptor of y is not changed */ static ERTS_INLINE void replace(RBTNode **root, RBTNode *x, RBTNode *y) @@ -398,17 +391,15 @@ replace(RBTNode **root, RBTNode *x, RBTNode *y) set_parent(x->right, y); } - /*y->flags = x->flags;*/ y->parent_and_color = x->parent_and_color; y->right = x->right; y->left = x->left; - /*SVERK y->max_sz = x->max_sz;*/ } static void -tree_insert_fixup(RBTNode** root, RBTNode *blk) +tree_insert_fixup(RBTNode** root, RBTNode *node) { - RBTNode *x = blk, *y, *papa_x, *granpa_x; + RBTNode *x = node, *y, *papa_x, *granpa_x; /* * Rearrange the tree so that it satisfies the Red-Black Tree properties @@ -501,14 +492,15 @@ tree_insert_fixup(RBTNode** root, RBTNode *blk) } static void -rbt_delete(RBTNode** root, RBTNode* del) +rbt_delete(RBTree* tree, RBTNode* del) { Uint spliced_is_black; RBTNode *x, *y, *z = del, *papa_y; RBTNode null_x; /* null_x is used to get the fixup started when we splice out a node without children. */ - HARD_CHECK_IS_MEMBER(*root, del); + HARD_CHECK_IS_MEMBER(tree->root, del); + HARD_CHECK_TREE(tree, 0); null_x.parent_and_color = parent_and_color(NULL, !RED_FLG); @@ -529,17 +521,14 @@ rbt_delete(RBTNode** root, RBTNode* del) } else if (spliced_is_black) { x = &null_x; - /*x->flags = 0; - SET_BLACK(x);*/ x->right = x->left = NULL; - /*SVERK x->max_sz = 0;*/ x->parent_and_color = parent_and_color(papa_y, !RED_FLG); y->left = x; } if (!papa_y) { - RBT_ASSERT(*root == y); - *root = x; + RBT_ASSERT(tree->root == y); + tree->root = x; } else { if (y == papa_y->left) { @@ -549,15 +538,11 @@ rbt_delete(RBTNode** root, RBTNode* del) RBT_ASSERT(y == papa_y->right); papa_y->right = x; } - /*SVERK if (y->parent != z) { - lower_max_size(y->parent, (y==z ? NULL : z)); - }*/ } if (y != z) { /* We spliced out the successor of z; replace z by the successor */ RBT_ASSERT(z != &null_x); - replace(root, z, y); - /*SVERK lower_max_size(y, NULL);*/ + replace(&tree->root, z, y); } if (spliced_is_black) { @@ -584,7 +569,7 @@ rbt_delete(RBTNode** root, RBTNode* del) SET_BLACK(y); RBT_ASSERT(IS_BLACK(papa_x)); SET_RED(papa_x); - left_rotate(root, papa_x); + left_rotate(&tree->root, papa_x); RBT_ASSERT(papa_x == parent(x)); y = papa_x->right; } @@ -597,7 +582,7 @@ rbt_delete(RBTNode** root, RBTNode* del) if (IS_BLACK(y->right)) { SET_BLACK(y->left); SET_RED(y); - right_rotate(root, y); + right_rotate(&tree->root, y); RBT_ASSERT(papa_x == parent(x)); y = papa_x->right; } @@ -609,8 +594,8 @@ rbt_delete(RBTNode** root, RBTNode* del) } RBT_ASSERT(y->right); SET_BLACK(y->right); - left_rotate(root, papa_x); - x = *root; + left_rotate(&tree->root, papa_x); + x = tree->root; break; } } @@ -624,7 +609,7 @@ rbt_delete(RBTNode** root, RBTNode* del) SET_BLACK(y); RBT_ASSERT(IS_BLACK(papa_x)); SET_RED(papa_x); - right_rotate(root, papa_x); + right_rotate(&tree->root, papa_x); RBT_ASSERT(papa_x == parent(x)); y = papa_x->left; } @@ -637,7 +622,7 @@ rbt_delete(RBTNode** root, RBTNode* del) if (IS_BLACK(y->left)) { SET_BLACK(y->right); SET_RED(y); - left_rotate(root, y); + left_rotate(&tree->root, y); RBT_ASSERT(papa_x == parent(x)); y = papa_x->left; } @@ -648,8 +633,8 @@ rbt_delete(RBTNode** root, RBTNode* del) } RBT_ASSERT(y->left); SET_BLACK(y->left); - right_rotate(root, papa_x); - x = *root; + right_rotate(&tree->root, papa_x); + x = tree->root; break; } } @@ -669,49 +654,44 @@ rbt_delete(RBTNode** root, RBTNode* del) RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); } - else if (*root == &null_x) { - *root = NULL; + else if (tree->root == &null_x) { + tree->root = NULL; RBT_ASSERT(!null_x.left); RBT_ASSERT(!null_x.right); } } + HARD_CHECK_TREE(tree, 0); } static void -rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) +rbt_insert(enum SortOrder order, RBTree* tree, RBTNode* node) { #ifdef RBT_DEBUG ErtsFreeSegDesc *dbg_under=NULL, *dbg_over=NULL; #endif - ErtsFreeSegDesc* desc = node_to_desc(order, blk); - char* blk_addr = desc->start; - SWord blk_sz = desc->end - desc->start; - /*SVERK Uint blk_sz = AOFF_BLK_SZ(blk);*/ - - /*blk->flags = 0;*/ - blk->left = NULL; - blk->right = NULL; - /*SVERK blk->max_sz = blk_sz;*/ - - if (!*root) { - blk->parent_and_color = parent_and_color(NULL, !RED_FLG); - /*SET_BLACK(blk);*/ - *root = blk; + ErtsFreeSegDesc* desc = node_to_desc(order, node); + char* seg_addr = desc->start; + SWord seg_sz = desc->end - desc->start; + + HARD_CHECK_TREE(tree, 0); + + node->left = NULL; + node->right = NULL; + + if (!tree->root) { + node->parent_and_color = parent_and_color(NULL, !RED_FLG); + tree->root = node; } else { - RBTNode *x = *root; + RBTNode *x = tree->root; while (1) { - SWord diff; - /*SVERK if (x->max_sz < blk_sz) { - x->max_sz = blk_sz; - }*/ - diff = cmp_with_block(order, blk_sz, blk_addr, x); + SWord diff = cmp_with_node(order, seg_sz, seg_addr, x); if (diff < 0) { IF_RBT_DEBUG(dbg_over = node_to_desc(order, x)); if (!x->left) { - blk->parent_and_color = parent_and_color(x, RED_FLG); - x->left = blk; + node->parent_and_color = parent_and_color(x, RED_FLG); + x->left = node; break; } x = x->left; @@ -720,43 +700,26 @@ rbt_insert(enum SortOrder order, RBTNode** root, RBTNode* blk) RBT_ASSERT(diff > 0); IF_RBT_DEBUG(dbg_under = node_to_desc(order, x)); if (!x->right) { - blk->parent_and_color = parent_and_color(x, RED_FLG); - x->right = blk; + node->parent_and_color = parent_and_color(x, RED_FLG); + x->right = node; break; } x = x->right; } - /*SVERK else { - ASSERT(flavor == AOFF_BF); - ASSERT(blk->flags & IS_BF_FLG); - ASSERT(x->flags & IS_BF_FLG); - SET_LIST_ELEM(blk); - LIST_NEXT(blk) = LIST_NEXT(x); - LIST_PREV(blk) = x; - if (LIST_NEXT(x)) - LIST_PREV(LIST_NEXT(x)) = blk; - LIST_NEXT(x) = blk; - return; - }*/ } - /* Insert block into size tree */ - RBT_ASSERT(parent(blk)); + RBT_ASSERT(parent(node)); #ifdef RBT_DEBUG - if (!order) { + if (order == ADDR_ORDER) { RBT_ASSERT(!dbg_under || dbg_under->end < desc->start); RBT_ASSERT(!dbg_over || dbg_over->start > desc->end); } #endif - /*SET_RED(blk);*/ - RBT_ASSERT(IS_RED(blk)); - if (IS_RED(parent(blk))) - tree_insert_fixup(root, blk); + RBT_ASSERT(IS_RED(node)); + if (IS_RED(parent(node))) + tree_insert_fixup(&tree->root, node); } - /*SVERK if (flavor == AOFF_BF) { - SET_TREE_NODE(blk); - LIST_NEXT(blk) = NULL; - }*/ + HARD_CHECK_TREE(tree, 0); } /* @@ -860,9 +823,39 @@ rbt_foreach_node(RBTree* tree, #endif } +#ifdef RBT_DEBUG +static RBTNode* rbt_prev_node(RBTNode* node) +{ + RBTNode* x; + if (node->left) { + for (x=node->left; x->right; x=x->right) + ; + return x; + } + for (x=node; parent(x); x=parent(x)) { + if (parent(x)->right == x) + return parent(x); + } + return NULL; +} +static RBTNode* rbt_next_node(RBTNode* node) +{ + RBTNode* x; + if (node->right) { + for (x=node->right; x->left; x=x->left) + ; + return x; + } + for (x=node; parent(x); x=parent(x)) { + if (parent(x)->left == x) + return parent(x); + } + return NULL; +} +#endif /* RBT_DEBUG */ -/* The API to keep track of a bunch of separated free segments +/* The API to keep track of a bunch of separated (free) segments (non-overlapping and non-adjacent). */ static void init_free_seg_map(ErtsFreeSegMap*, int reverse_ao); @@ -883,6 +876,9 @@ static void init_free_seg_map(ErtsFreeSegMap* map, int reverse_ao) map->nseg = 0; } +/* Lookup directly adjacent free segments to the given area [start->end]. + * The given area must not contain any free segments. + */ static void adjacent_free_seg(ErtsFreeSegMap* map, char* start, char* end, ErtsFreeSegDesc** under, ErtsFreeSegDesc** over) { @@ -910,39 +906,49 @@ static void adjacent_free_seg(ErtsFreeSegMap* map, char* start, char* end, } } +/* Initialize 'desc' and insert as new free segment [start->end]. + * The new segment must not contain or be adjacent to any free segment in 'map'. + */ static void insert_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, char* start, char* end) { desc->start = start; desc->end = end; - rbt_insert(map->atree.order, &map->atree.root, &desc->anode); - rbt_insert(map->stree.order, &map->stree.root, &desc->snode); + rbt_insert(map->atree.order, &map->atree, &desc->anode); + rbt_insert(map->stree.order, &map->stree, &desc->snode); map->nseg++; } +/* Resize existing free segment 'desc' to [start->end]. + * The new segment location must overlap the old location and + * it must not contain or be adjacent to any other free segment in 'map'. + */ static void resize_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, char* start, char* end) { -#ifdef DEBUG - ErtsFreeSegDesc *dbg_under, *dbg_over; - rbt_delete(&map->atree.root, &desc->anode); - adjacent_free_seg(map, start, end, &dbg_under, &dbg_over); - RBT_ASSERT(dbg_under == NULL && dbg_over == NULL); - rbt_insert(map->atree.order, &map->atree.root, &desc->anode); +#ifdef RBT_DEBUG + RBTNode* prev = rbt_prev_node(&desc->anode); + RBTNode* next = rbt_next_node(&desc->anode); + RBT_ASSERT(!prev || anode_to_desc(prev)->end < start); + RBT_ASSERT(!next || anode_to_desc(next)->start > end); #endif - rbt_delete(&map->stree.root, &desc->snode); + rbt_delete(&map->stree, &desc->snode); desc->start = start; desc->end = end; - rbt_insert(map->stree.order, &map->stree.root, &desc->snode); + rbt_insert(map->stree.order, &map->stree, &desc->snode); } +/* Delete existing free segment 'desc' from 'map'. + */ static void delete_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc) { - rbt_delete(&map->atree.root, &desc->anode); - rbt_delete(&map->stree.root, &desc->snode); + rbt_delete(&map->atree, &desc->anode); + rbt_delete(&map->stree, &desc->snode); map->nseg--; } +/* Lookup a free segment in 'map' with a size of at least 'need_sz' bytes. + */ static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) { RBTNode* x = map->stree.root; @@ -1934,7 +1940,7 @@ static int rbt_assert_is_member(RBTNode* root, RBTNode* node) } -#if 1 /*SVERK*/ +#if 0 # define PRINT_TREE #else # undef PRINT_TREE @@ -1964,7 +1970,7 @@ struct check_arg_t { Uint size; RBTNode *res; }; -static void check_node(RBTNode* x, void* arg); +static void check_node_callback(RBTNode* x, void* arg); static RBTNode * @@ -1986,13 +1992,12 @@ check_tree(RBTree* tree, Uint size) RBT_ASSERT(IS_BLACK(tree->root)); RBT_ASSERT(!parent(tree->root)); - rbt_foreach_node(tree, check_node, &carg, 0); + rbt_foreach_node(tree, check_node_callback, &carg, 0); return carg.res; } -/* callback */ -static void check_node(RBTNode* x, void* arg) +static void check_node_callback(RBTNode* x, void* arg) { struct check_arg_t* a = (struct check_arg_t*) arg; ErtsFreeSegDesc* seg; @@ -2005,16 +2010,16 @@ static void check_node(RBTNode* x, void* arg) RBT_ASSERT(parent(x) || x == a->tree->root); if (x->left) { - RBT_ASSERT(cmp_blocks(a->tree->order, x->left, x) < 0); + RBT_ASSERT(cmp_nodes(a->tree->order, x->left, x) < 0); } if (x->right) { - RBT_ASSERT(cmp_blocks(a->tree->order, x->right, x) > 0); + RBT_ASSERT(cmp_nodes(a->tree->order, x->right, x) > 0); } seg = node_to_desc(a->tree->order, x); RBT_ASSERT(seg->start < seg->end); if (a->size && (seg->end - seg->start) >= a->size) { - if (!a->res || cmp_blocks(a->tree->order, x, a->res) < 0) { + if (!a->res || cmp_nodes(a->tree->order, x, a->res) < 0) { a->res = x; } } @@ -2063,6 +2068,8 @@ print_tree(enum SortOrder order, RBTNode* root) #endif /* PRINT_TREE */ +#ifdef FREE_SEG_API_SMOKE_TEST + void test_it(void) { ErtsFreeSegMap map; @@ -2128,3 +2135,5 @@ void test_it(void) ERTS_ASSERT(d1->start == (char*)0x15000); } } + +#endif /* FREE_SEG_API_SMOKE_TEST */ -- cgit v1.2.3 From d04e3d43f3a96030db0c9b8da8f88cb78f8ec8dc Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Thu, 5 Sep 2013 14:45:26 +0200 Subject: erts: Improve erts_mmap out of free descriptor management --- erts/emulator/sys/common/erl_mmap.c | 100 +++++++++++++++++++++--------------- 1 file changed, 60 insertions(+), 40 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 723efa772f..0ac08a0004 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -222,6 +222,7 @@ static struct { mmap_state.size.os.used -= (SZ); \ } while (0) + static void add_free_desc_area(char *start, char *end) { @@ -1164,6 +1165,39 @@ static void unreserve_noop(char *ptr, UWord size) #endif } +static ERTS_INLINE UWord +alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) +{ + UWord ad_sz; + char *new_end; + ErtsFreeSegDesc *desc = alloc_desc(); + if (desc) { + insert_free_seg(map, desc, start, end); + return 0; + } + + /* Use part of the free segment for descriptors */ + + if (map == &mmap_state.sa.map) { + ERTS_MMAP_SIZE_SC_SA_INC(ERTS_SUPERALIGNED_SIZE); + ad_sz = ERTS_SUPERALIGNED_SIZE; + } + else { + ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE); + ad_sz = ERTS_PAGEALIGNED_SIZE; + } + + new_end = end - ad_sz; + ERTS_MMAP_ASSERT(start <= new_end); + if (start != new_end) { + desc = alloc_desc(); + ERTS_MMAP_ASSERT(desc); + insert_free_seg(map, desc, start, new_end); + } + + return ad_sz; +} + void * erts_mmap(Uint32 flags, UWord *sizep) { @@ -1248,6 +1282,7 @@ erts_mmap(Uint32 flags, UWord *sizep) end = seg + asize; if (!mmap_state.reserve_physical(seg, asize)) goto supercarrier_reserve_failure; + ERTS_MMAP_SIZE_SC_SUA_INC(asize); if (org_start != seg) { ERTS_MMAP_ASSERT(org_start < seg); resize_free_seg(&mmap_state.sua.map, desc, org_start, seg); @@ -1257,15 +1292,10 @@ erts_mmap(Uint32 flags, UWord *sizep) ERTS_MMAP_ASSERT(end < org_end); if (desc) resize_free_seg(&mmap_state.sua.map, desc, end, org_end); - else { - desc = alloc_desc(); - if (!desc) - add_free_desc_area(end, org_end); - else - insert_free_seg(&mmap_state.sua.map, desc, end, org_end); - } + else + alloc_desc_insert_free_seg(&mmap_state.sua.map, + end, org_end); } - ERTS_MMAP_SIZE_SC_SA_INC(asize); goto supercarrier_success; } } @@ -1361,6 +1391,7 @@ erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) char *start, *end; ErtsFreeSegMap *map; ErtsFreeSegDesc *prev, *next, *desc; + UWord ad_sz = 0; ERTS_MMAP_ASSERT(mmap_state.supercarrier); @@ -1432,23 +1463,19 @@ erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) if (desc) resize_free_seg(map, desc, start, end); - else { - desc = alloc_desc(); - if (desc) - insert_free_seg(map, desc, start, end); - else { - if (map == &mmap_state.sa.map) - ERTS_MMAP_SIZE_SC_SA_INC(size); - else - ERTS_MMAP_SIZE_SC_SUA_INC(size); - add_free_desc_area(start, end); - } - } + else + ad_sz = alloc_desc_insert_free_seg(map, start, end); + + supercarrier_success: { + UWord unres_sz; - supercarrier_success: - erts_smp_mtx_unlock(&mmap_state.mtx); + erts_smp_mtx_unlock(&mmap_state.mtx); - mmap_state.unreserve_physical((char *) ptr, size); + ERTS_MMAP_ASSERT(size >= ad_sz); + unres_sz = size - ad_sz; + if (unres_sz) + mmap_state.unreserve_physical((char *) ptr, unres_sz); + } } } @@ -1548,7 +1575,8 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) else { /* In super carrier */ char *start, *end, *new_end; ErtsFreeSegMap *map; - ErtsFreeSegDesc *prev, *next, *desc; + ErtsFreeSegDesc *prev, *next; + UWord ad_sz = 0; ERTS_MMAP_ASSERT(mmap_state.supercarrier); @@ -1586,6 +1614,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) new_end = start+asize; if (asize < old_size) { + UWord unres_sz; new_ptr = ptr; if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); @@ -1620,21 +1649,13 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) if (next) resize_free_seg(map, next, new_end, next->end); - else { - desc = alloc_desc(); - if (desc) - insert_free_seg(map, desc, new_end, end); - else { - if (map == &mmap_state.sa.map) - ERTS_MMAP_SIZE_SC_SA_INC(old_size - asize); - else - ERTS_MMAP_SIZE_SC_SUA_INC(old_size - asize); - add_free_desc_area(new_end, end); - goto supercarrier_resize_success; - } - } - mmap_state.unreserve_physical(((char *) ptr) + asize, - old_size - asize); + else + ad_sz = alloc_desc_insert_free_seg(map, new_end, end); + ERTS_MMAP_ASSERT(old_size - asize >= ad_sz); + unres_sz = old_size - asize - ad_sz; + if (unres_sz) + mmap_state.unreserve_physical(((char *) ptr) + asize, + unres_sz); goto supercarrier_resize_success; } @@ -1921,7 +1942,6 @@ erts_mmap_init(ErtsMMapInit *init) #endif } - /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Debug functions * \* */ -- cgit v1.2.3 From 0820017c421bfab27d23aff4da474974f988006c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 5 Sep 2013 19:23:07 +0200 Subject: erts: Add mmap argument to erts_debug:get_internal_state --- erts/emulator/beam/erl_bif_info.c | 3 +++ erts/emulator/sys/common/erl_mmap.c | 48 ++++++++++++++++++++++++++++++++++++- erts/emulator/sys/common/erl_mmap.h | 2 ++ 3 files changed, 52 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index a4f9f787cd..7aa439f2e6 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3289,6 +3289,9 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) erts_smp_thr_progress_unblock(); BIF_RET(res); } + else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) { + BIF_RET(erts_mmap_info(BIF_P)); + } } else if (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 0ac08a0004..1d18c1fcc9 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -23,6 +23,7 @@ #include "sys.h" #include "erl_process.h" #include "erl_smp.h" +#include "atom.h" #include "erl_mmap.h" #include @@ -741,7 +742,7 @@ rbt_foreach_node(RBTree* tree, enum { RECURSE_LEFT, DO_NODE, RECURSE_RIGHT, RETURN_TO_PARENT }state; RBTNode *x = tree->root; - RBT_ASSERT(!parent(x)); + RBT_ASSERT(!x || !parent(x)); state = reverse ? RECURSE_RIGHT : RECURSE_LEFT; while (x) { @@ -1942,6 +1943,51 @@ erts_mmap_init(ErtsMMapInit *init) #endif } +Eterm erts_mmap_info(Process* p) +{ + if (mmap_state.supercarrier) { + ERTS_DECL_AM(sabot); + ERTS_DECL_AM(satop); + ERTS_DECL_AM(suabot); + ERTS_DECL_AM(suatop); + Eterm sa_list, sua_list, list; + Eterm tags[] = { AM_sabot, AM_satop, AM_suabot, AM_suatop }; + UWord values[4]; + Eterm *hp, *hp_end; + Uint may_need; + const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2; + + erts_smp_mtx_lock(&mmap_state.mtx); + values[0] = (UWord)mmap_state.sa.bot; + values[1] = (UWord)mmap_state.sa.top; + values[2] = (UWord)mmap_state.sua.bot; + values[3] = (UWord)mmap_state.sua.top; + sa_list = build_free_seg_list(p, &mmap_state.sa.map); + sua_list = build_free_seg_list(p, &mmap_state.sua.map); + erts_smp_mtx_unlock(&mmap_state.mtx); + + may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3); + hp = HAlloc(p, may_need); + hp_end = hp + may_need; + + list = erts_bld_atom_uint_2tup_list(&hp, NULL, + sizeof(values)/sizeof(*values), + tags, values); + + sa_list = TUPLE2(hp, am_atom_put("sa_free_segs",12), sa_list); hp+=3; + sua_list = TUPLE2(hp, am_atom_put("sua_free_segs",13), sua_list); hp+=3; + list = CONS(hp, sua_list, list); hp+=2; + list = CONS(hp, sa_list, list); hp+=2; + + ASSERT(hp <= hp_end); + HRelease(p, hp_end, hp); + return list; + } + else { + return am_undefined; + } +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Debug functions * \* */ diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 143f1aff3e..b75200f4e9 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -57,6 +57,8 @@ void erts_munmap(Uint32 flags, void **ptrp, UWord *sizep); void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep); int erts_mmap_in_supercarrier(void *ptr); void erts_mmap_init(ErtsMMapInit*); +struct process; +Eterm erts_mmap_info(struct process*); #define ERTS_SUPERALIGNED_SIZE \ (1 << ERTS_MMAP_SUPERALIGNED_BITS) -- cgit v1.2.3 From 2d64c6e31966d9e63d1aa1835d41ded22f799175 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 6 Sep 2013 19:34:02 +0200 Subject: erts: Fix ASSERT bug and void* arithmetics --- erts/emulator/sys/common/erl_mseg.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index b21d6ca393..09035ca73e 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -515,7 +515,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag if (MSEG_FLG_IS_2POW(flags)) { int i, ix = SIZE_TO_CACHE_AREA_IDX(size); - void *seg; + char *seg; cache_t *c; Uint csize; @@ -533,7 +533,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT(MAP_IS_ALIGNED(c->seg)); csize = c->size; - seg = c->seg; + seg = (char*) c->seg; mk->cache_size--; mk->cache_hits++; @@ -545,11 +545,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT(!(mk->cache_size < 0)); if (csize != size) { - void *destr_seg = ((char *) seg) + size; + char *destr_seg = seg + size; UWord destr_size = csize - size; - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, &destr_seg, &destr_size); + mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, (void**)&destr_seg, &destr_size); *size_p = (UWord) (destr_seg - seg); - ASSERT(c->seg + c->size == destr_seg + destr_size); + ASSERT(seg + csize == destr_seg + destr_size); } return seg; -- cgit v1.2.3 From ac32bccf21354d7e6896d8b83b6e9a45bb1bccd7 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 9 Sep 2013 15:49:21 +0200 Subject: erts: Sort tree in super aligned sizes (SA_SZ_ADDR_ORDER) --- erts/emulator/sys/common/erl_mmap.c | 52 +++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 20 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 1d18c1fcc9..eae1a1a410 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -106,9 +106,12 @@ static ERTS_INLINE UWord parent_and_color(RBTNode* parent, int color) enum SortOrder { ADDR_ORDER, /* only address order */ - SZ_ADDR_ORDER, /* first size then address order as tiebreaker */ + SA_SZ_ADDR_ORDER, /* first super-aligned size then address order */ SZ_REVERSE_ADDR_ORDER /* first size then reverse address order */ }; +#ifdef HARD_DEBUG +static const char* sort_order_names[] = {"Address","SuperAlignedSize-Address","Size-RevAddress"}; +#endif typedef struct { RBTNode* root; @@ -286,9 +289,17 @@ static ERTS_INLINE SWord cmp_nodes(enum SortOrder order, ErtsFreeSegDesc* rdesc = node_to_desc(order, rhs); RBT_ASSERT(lhs != rhs); if (order != ADDR_ORDER) { - SWord lsz = ldesc->end - ldesc->start; - SWord rsz = rdesc->end - rdesc->start; - SWord diff = lsz - rsz; + SWord lsz, rsz, diff; + if (order == SA_SZ_ADDR_ORDER) { + lsz = ERTS_SUPERALIGNED_FLOOR(ldesc->end) - ERTS_SUPERALIGNED_CEILING(ldesc->start); + rsz = ERTS_SUPERALIGNED_FLOOR(rdesc->end) - ERTS_SUPERALIGNED_CEILING(rdesc->start); + } + else { + RBT_ASSERT(order == SZ_REVERSE_ADDR_ORDER); + lsz = ldesc->end - ldesc->start; + rsz = rdesc->end - rdesc->start; + } + diff = lsz - rsz; if (diff) return diff; } if (order != SZ_REVERSE_ADDR_ORDER) { @@ -305,12 +316,14 @@ static ERTS_INLINE SWord cmp_with_node(enum SortOrder order, { ErtsFreeSegDesc* rdesc; if (order != ADDR_ORDER) { + SWord rhs_sz, diff; rdesc = snode_to_desc(rhs); - { - SWord rhs_sz = rdesc->end - rdesc->start; - SWord diff = sz - rhs_sz; - if (diff) return diff; - } + if (order == SA_SZ_ADDR_ORDER) + rhs_sz = ERTS_SUPERALIGNED_FLOOR(rdesc->end) - ERTS_SUPERALIGNED_CEILING(rdesc->start); + else + rhs_sz = rdesc->end - rdesc->start; + diff = sz - rhs_sz; + if (diff) return diff; } else rdesc = anode_to_desc(rhs); @@ -860,7 +873,7 @@ static RBTNode* rbt_next_node(RBTNode* node) /* The API to keep track of a bunch of separated (free) segments (non-overlapping and non-adjacent). */ -static void init_free_seg_map(ErtsFreeSegMap*, int reverse_ao); +static void init_free_seg_map(ErtsFreeSegMap*, enum SortOrder); static void adjacent_free_seg(ErtsFreeSegMap*, char* start, char* end, ErtsFreeSegDesc** under, ErtsFreeSegDesc** over); static void insert_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*, char* start, char* end); @@ -869,12 +882,12 @@ static void delete_free_seg(ErtsFreeSegMap*, ErtsFreeSegDesc*); static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap*, SWord sz); -static void init_free_seg_map(ErtsFreeSegMap* map, int reverse_ao) +static void init_free_seg_map(ErtsFreeSegMap* map, enum SortOrder order) { map->atree.root = NULL; map->atree.order = ADDR_ORDER; map->stree.root = NULL; - map->stree.order = reverse_ao ? SZ_REVERSE_ADDR_ORDER : SZ_ADDR_ORDER; + map->stree.order = order; map->nseg = 0; } @@ -1931,8 +1944,8 @@ erts_mmap_init(ErtsMMapInit *init) #endif add_free_desc_area(mmap_state.sua.top, end); - init_free_seg_map(&mmap_state.sa.map, 0); - init_free_seg_map(&mmap_state.sua.map, 1); + init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER); + init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER); mmap_state.supercarrier = 1; erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; @@ -2125,10 +2138,9 @@ print_tree_aux(enum SortOrder order, RBTNode *x, int indent) static void print_tree(enum SortOrder order, RBTNode* root) { - static const char* type[] = {"Address","Size-Address","Size-RevAddress"}; - fprintf(stderr, " --- %s ordered tree begin ---\r\n", type[order]); + fprintf(stderr, " --- %s ordered tree begin ---\r\n", sort_order_names[order]); print_tree_aux(order, root, 0); - fprintf(stderr, " --- %s ordered tree end ---\r\n", type[order]); + fprintf(stderr, " --- %s ordered tree end ---\r\n", sort_order_names[order]); } #endif /* PRINT_TREE */ @@ -2140,10 +2152,10 @@ void test_it(void) { ErtsFreeSegMap map; ErtsFreeSegDesc *desc, *under, *over, *d1, *d2; - int i; + const int i = 1; /* reverse addr order */ - for (i=0; i<2; i++) { - init_free_seg_map(&map, i); + { + init_free_seg_map(&map, SZ_REVERSE_ADDR_ORDER); insert_free_seg(&map, alloc_desc(), (char*)0x11000, (char*)0x12000); HARD_CHECK_TREE(&map.atree, 0); HARD_CHECK_TREE(&map.stree, 0); -- cgit v1.2.3 From c8f87b4ec91b67c9d3373c8466a07db638e32cc2 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 9 Sep 2013 16:07:29 +0200 Subject: erts: Allow page aligned erts_munmap() --- erts/emulator/sys/common/erl_mmap.c | 102 +++++++++++++++++------------------- erts/emulator/sys/common/erl_mmap.h | 2 +- erts/emulator/sys/common/erl_mseg.c | 70 +++++++------------------ 3 files changed, 67 insertions(+), 107 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index eae1a1a410..73874759f5 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -1260,30 +1260,53 @@ erts_mmap(Uint32 flags, UWord *sizep) desc = lookup_free_seg(&mmap_state.sa.map, asize); if (desc) { - seg = desc->start; + char *start = seg = desc->start; + seg = (char *) ERTS_SUPERALIGNED_CEILING(seg); end = seg+asize; - if (!mmap_state.reserve_physical(seg, asize)) + if (!mmap_state.reserve_physical(start, (UWord) (end - start))) goto supercarrier_reserve_failure; + ERTS_MMAP_SIZE_SC_SA_INC(asize); if (desc->end == end) { - delete_free_seg(&mmap_state.sa.map, desc); - free_desc(desc); + if (start != seg) + resize_free_seg(&mmap_state.sa.map, desc, start, seg); + else { + delete_free_seg(&mmap_state.sa.map, desc); + free_desc(desc); + } } else { ERTS_MMAP_ASSERT(end < desc->end); resize_free_seg(&mmap_state.sa.map, desc, end, desc->end); + if (start != seg) { + UWord ad_sz; + ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + start, seg); + start += ad_sz; + if (start != seg) + mmap_state.unreserve_physical(start, (UWord) (seg - start)); + } } - ERTS_MMAP_SIZE_SC_SA_INC(asize); goto supercarrier_success; } if (superaligned) { + seg = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.top); - if (asize <= mmap_state.sua.bot - mmap_state.sa.top) { - seg = (void *) mmap_state.sa.top; - if (!mmap_state.reserve_physical(seg, asize)) + if (asize <= mmap_state.sua.bot - seg) { + char *start = mmap_state.sa.top; + end = seg + asize; + if (!mmap_state.reserve_physical(start, (UWord) (end - start))) goto supercarrier_reserve_failure; - mmap_state.sa.top += asize; + mmap_state.sa.top = end; ERTS_MMAP_SIZE_SC_SA_INC(asize); + if (start != seg) { + UWord ad_sz; + ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + start, seg); + start += ad_sz; + if (start != seg) + mmap_state.unreserve_physical(start, (UWord) (seg - start)); + } goto supercarrier_success; } @@ -1294,7 +1317,7 @@ erts_mmap(Uint32 flags, UWord *sizep) seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start); end = seg + asize; - if (!mmap_state.reserve_physical(seg, asize)) + if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg))) goto supercarrier_reserve_failure; ERTS_MMAP_SIZE_SC_SUA_INC(asize); if (org_start != seg) { @@ -1303,12 +1326,17 @@ erts_mmap(Uint32 flags, UWord *sizep) desc = NULL; } if (end != org_end) { + UWord ad_sz = 0; ERTS_MMAP_ASSERT(end < org_end); if (desc) resize_free_seg(&mmap_state.sua.map, desc, end, org_end); else - alloc_desc_insert_free_seg(&mmap_state.sua.map, - end, org_end); + ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map, + end, org_end); + end += ad_sz; + if (end != org_end) + mmap_state.unreserve_physical(end, + (UWord) (org_end - end)); } goto supercarrier_success; } @@ -1363,8 +1391,7 @@ erts_mmap(Uint32 flags, UWord *sizep) supercarrier_success: #ifdef ERTS_MMAP_DEBUG - if ((ERTS_MMAPFLG_SUPERALIGNED & flags) - || ERTS_MMAP_IN_SUPERALIGNED_AREA(seg)) { + if (ERTS_MMAPFLG_SUPERALIGNED & flags) { ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(seg)); ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); } @@ -1388,10 +1415,8 @@ supercarrier_reserve_failure: } void -erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) +erts_munmap(Uint32 flags, void *ptr, UWord size) { - void *ptr = *ptrp; - UWord size = *sizep; ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size)); if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { @@ -1416,13 +1441,6 @@ erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { - start = (char *) ERTS_SUPERALIGNED_CEILING(start); - end = (char *) ERTS_SUPERALIGNED_FLOOR(end); - - size = (UWord) (end - start); - *ptrp = start; - *sizep = size; - map = &mmap_state.sa.map; adjacent_free_seg(map, start, end, &prev, &next); @@ -1439,8 +1457,6 @@ erts_munmap(Uint32 flags, void **ptrp, UWord *sizep) } } else { - ERTS_MMAP_ASSERT(ERTS_MMAP_IN_SUPERUNALIGNED_AREA(ptr)); - map = &mmap_state.sua.map; adjacent_free_seg(map, start, end, &prev, &next); @@ -1497,8 +1513,6 @@ static void * remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) { UWord size = *sizep; - UWord um_size = old_size; - void *um_ptr = ptr; void *new_ptr = erts_mmap(flags, &size); if (!new_ptr) return NULL; @@ -1506,9 +1520,7 @@ remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) if (old_size < size) size = old_size; sys_memcpy(new_ptr, ptr, (size_t) size); - erts_munmap(flags, &um_ptr, &um_size); - ERTS_MMAP_ASSERT(um_ptr == ptr); - ERTS_MMAP_ASSERT(um_size == old_size); + erts_munmap(flags, ptr, old_size); return new_ptr; } @@ -1627,28 +1639,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) end = start + old_size; new_end = start+asize; + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); + ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); + if (asize < old_size) { UWord unres_sz; new_ptr = ptr; if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { - ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); - ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size)); - ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize)); map = &mmap_state.sua.map; ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize); } else { - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(ptr)); - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(old_size)); - if (!superaligned) { - /* must be a superaligned size in this area */ - asize = ERTS_SUPERALIGNED_CEILING(asize); - ERTS_MMAP_ASSERT(asize <= old_size); - if (asize == old_size) - goto supercarrier_resize_success; - new_end = start+asize; - } - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); if (end == mmap_state.sa.top) { mmap_state.sa.top = new_end; mmap_state.unreserve_physical(((char *) ptr) + asize, @@ -1696,16 +1698,6 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) } } else { /* Superaligned area */ - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(ptr)); - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(old_size)); - - if (!superaligned) { - /* must be a superaligned size in this area */ - asize = ERTS_PAGEALIGNED_CEILING(asize); - new_end = start+asize; - } - - ERTS_MMAP_ASSERT(ERTS_IS_SUPERALIGNED(asize)); if (end == mmap_state.sa.top) { if (new_end <= mmap_state.sua.bot) { diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index b75200f4e9..6cb51fb0b4 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -53,7 +53,7 @@ typedef struct { {{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1} void *erts_mmap(Uint32 flags, UWord *sizep); -void erts_munmap(Uint32 flags, void **ptrp, UWord *sizep); +void erts_munmap(Uint32 flags, void *ptr, UWord size); void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep); int erts_mmap_in_supercarrier(void *ptr); void erts_mmap_init(ErtsMMapInit*); diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 09035ca73e..2474015bcb 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -330,7 +330,7 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep) } static ERTS_INLINE void -mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void **seg_pp, UWord *size_p) { +mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) { Uint32 mmap_flags = 0; #if HALFWORD_HEAP @@ -341,11 +341,11 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void **seg_pp, UWord if (MSEG_FLG_IS_2POW(flags)) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - erts_munmap(mmap_flags, seg_pp, size_p); + erts_munmap(mmap_flags, seg_p, size); #ifdef ERTS_PRINT_ERTS_MMAP erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n", (mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua", - *seg_pp, *size_p); + seg_p, *size); #endif INC_CC(ma, destroy); @@ -446,19 +446,13 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui return 1; } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) { - void *destr_seg; - UWord destr_size; /* No free slots. * Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */ c = erts_circleq_tail(&(mk->cache_unpowered_node)); erts_circleq_remove(c); - destr_seg = c->seg; - destr_size = c->size; - mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, &destr_seg, &destr_size); - ASSERT(destr_seg == c->seg); - ASSERT(destr_size == c->size); + mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size); mseg_cache_clear_node(c); c->seg = seg; @@ -478,19 +472,13 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui int i; for( i = 0; i < CACHE_AREAS; i++) { - void *destr_seg; - UWord destr_size; if (erts_circleq_is_empty(&(mk->cache_powered_node[i]))) continue; c = erts_circleq_tail(&(mk->cache_powered_node[i])); erts_circleq_remove(c); - destr_seg = seg; - destr_size = c->size; - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, &destr_seg, &destr_size); - ASSERT(destr_seg == c->seg); - ASSERT(destr_size == c->size); + mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size); mseg_cache_clear_node(c); @@ -544,13 +532,8 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT(!(mk->cache_size < 0)); - if (csize != size) { - char *destr_seg = seg + size; - UWord destr_size = csize - size; - mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, (void**)&destr_seg, &destr_size); - *size_p = (UWord) (destr_seg - seg); - ASSERT(seg + csize == destr_seg + destr_size); - } + if (csize != size) + mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size); return seg; } @@ -625,8 +608,6 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag */ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) { - void *destr_seg; - UWord destr_size; cache_t *c = NULL; c = erts_circleq_tail(head); @@ -635,11 +616,7 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - destr_seg = c->seg; - destr_size = c->size; - mseg_destroy(mk->ma, flags, mk, &destr_seg, &destr_size); - ASSERT(destr_seg == c->seg); - ASSERT(destr_size == c->size); + mseg_destroy(mk->ma, flags, mk, c->seg, c->size); mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); @@ -655,8 +632,6 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca cache_t *c = NULL; while (!erts_circleq_is_empty(head)) { - void *destr_seg; - UWord destr_size; c = erts_circleq_tail(head); erts_circleq_remove(c); @@ -664,11 +639,7 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca if (erts_mtrace_enabled) erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - destr_seg = c->seg; - destr_size = c->size; - mseg_destroy(mk->ma, flags, mk, &destr_seg, &destr_size); - ASSERT(destr_seg == c->seg); - ASSERT(destr_size == c->size); + mseg_destroy(mk->ma, flags, mk, c->seg, c->size); mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); @@ -813,12 +784,14 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p, INC_CC(ma, alloc); - if (!MSEG_FLG_IS_2POW(flags) && !IS_2POW(size)) + if (!MSEG_FLG_IS_2POW(flags)) size = ERTS_PAGEALIGNED_CEILING(*size_p); else { size = ALIGNED_CEILING(*size_p); - /* Cache optim (if applicable) */ - size = ceil_2pow(size); + if (!IS_2POW(size)) { + /* Cache optim (if applicable) */ + size = ceil_2pow(size); + } } if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL) @@ -845,8 +818,6 @@ static void mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, Uint flags, const ErtsMsegOpt_t *opt) { - void *destr_seg; - UWord destr_size; MemKind* mk = memkind(ma, opt); ERTS_MSEG_DEALLOC_STAT(mk,size); @@ -859,11 +830,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, if (erts_mtrace_enabled) erts_mtrace_crr_free(atype, SEGTYPE, seg); - destr_seg = seg; - destr_size = size; - mseg_destroy(ma, flags, mk, &destr_seg, &destr_size); - ASSERT(destr_seg == seg); - ASSERT(destr_size == size); + mseg_destroy(ma, flags, mk, seg, size); done: @@ -896,13 +863,14 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, mk = memkind(ma, opt); new_seg = seg; - if (!MSEG_FLG_IS_2POW(flags)) new_size = ERTS_PAGEALIGNED_CEILING(*new_size_p); else { new_size = ALIGNED_CEILING(*new_size_p); - /* Cache optim (if applicable) */ - new_size = ceil_2pow(new_size); + if (!IS_2POW(new_size)) { + /* Cache optim (if applicable) */ + new_size = ceil_2pow(new_size); + } } if (new_size > old_size) { -- cgit v1.2.3 From ffbd1fe3fe4fdd1657f98d650eb3b40139e4b115 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Tue, 10 Sep 2013 15:33:33 +0200 Subject: erts: Add documentation for +MMsc* system flags --- erts/doc/src/erts_alloc.xml | 59 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 6ce2261430..9dab5b3876 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -271,6 +271,65 @@ memory segment cache is not reused if its size exceeds the requested size with more than relative max cache bad fit percent of the requested size. Default value is 20. + ]]> + + Set super carrier max guaranteed + no of carriers. This parameter defaults to 65536. This + parameter determines an amount of pre-allocated structures that is + needed in order to keep track of different areas in the super carrier. + When the system runs out of such structures it may crash due to an + out of memory condition. + + + + Set super carrier only flag. This + flag defaults to true. When a super carrier is used and this + flag is true, the system will crash when a carrier request + cannot be satisfied by the super carrier. When the flag is false + the system will try to create requested carrier by other means. +

+ NOTE: Setting this flag to false may not be supported + on all systems. This flag will in that case be ignored. +

+ NOTE: The super carrier cannot be enabled nor + disabled on halfword heap systems. This flag will be + ignored on halfword heap systems. + + + + Set super carrier reserve physical + memory flag. This flag defaults to true. When this flag is + true, physical memory will be reserved for the whole super + carrier at once when it is created. The reservation will after that + be left unchanged. When this flag is set to false only virtual + address space will be reserved for the super carrier upon creation. + The system will attempt to reserve physical memory upon carrier + creations in the super carrier, and attempt to unreserve physical + memory upon carrier destructions in the super carrier. +

+ NOTE: What reservation of physical memory actually means + highly depends on the operating system, and how it is configured. For + example, different memory overcommit settings on Linux drastically + change the behaviour. Also note, setting this flag to false + may not be supported on all systems. This flag will in that case + be ignored. +

+ NOTE: The super carrier cannot be enabled nor + disabled on halfword heap systems. This flag will be + ignored on halfword heap systems. + + ]]> + + Set super carrier size (in MB). The super carrier size defaults to + zero; i.e, the super carrier is by default disabled. The super + carrier is a large continuous area in the virtual address space. + The system will always try to create new carriers in the super + carrier. +

+ NOTE: The super carrier cannot be enabled nor + disabled on halfword heap systems. This flag will be + ignored on halfword heap systems. + ]]> Max cached segments. The maximum number of memory segments -- cgit v1.2.3 From e107965576ccd0cfd4f235e463cd6cc8da11a259 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Fri, 13 Sep 2013 02:07:03 +0200 Subject: erts: erts_mmap improved free seg desc management --- erts/emulator/sys/common/erl_mmap.c | 389 +++++++++++++++++++++++++++++++----- erts/emulator/sys/common/erl_mseg.c | 22 +- 2 files changed, 349 insertions(+), 62 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 73874759f5..1f9168df28 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -27,9 +27,18 @@ #include "erl_mmap.h" #include +/* #define ERTS_MMAP_OP_RINGBUF_SZ 100 */ + #if defined(DEBUG) || 0 # undef ERTS_MMAP_DEBUG # define ERTS_MMAP_DEBUG +# ifndef ERTS_MMAP_OP_RINGBUF_SZ +# define ERTS_MMAP_OP_RINGBUF_SZ 100 +# endif +#endif + +#ifndef ERTS_MMAP_OP_RINGBUF_SZ +# define ERTS_MMAP_OP_RINGBUF_SZ 0 #endif /* #define ERTS_MMAP_DEBUG_FILL_AREAS */ @@ -128,6 +137,148 @@ static RBTNode* check_tree(RBTree* tree, Uint); # define HARD_CHECK_TREE(TREE,SZ) #endif +#if ERTS_MMAP_OP_RINGBUF_SZ + +static int mmap_op_ix; + +typedef enum { + ERTS_OP_TYPE_NONE, + ERTS_OP_TYPE_MMAP, + ERTS_OP_TYPE_MUNMAP, + ERTS_OP_TYPE_MREMAP +} ErtsMMapOpType; + +typedef struct { + ErtsMMapOpType type; + void *result; + UWord in_size; + UWord out_size; + void *old_ptr; + UWord old_size; +} ErtsMMapOp; + +static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ]; + +#define ERTS_MMAP_OP_RINGBUF_INIT() \ + do { \ + int ix__; \ + for (ix__ = 0; ix__ < ERTS_MMAP_OP_RINGBUF_SZ; ix__++) {\ + mmap_ops[ix__].type = ERTS_OP_TYPE_NONE; \ + mmap_ops[ix__].result = NULL; \ + mmap_ops[ix__].in_size = 0; \ + mmap_ops[ix__].out_size = 0; \ + mmap_ops[ix__].old_ptr = NULL; \ + mmap_ops[ix__].old_size = 0; \ + } \ + mmap_op_ix = ERTS_MMAP_OP_RINGBUF_SZ-1; \ + } while (0) + +#define ERTS_MMAP_OP_START(SZ) \ + do { \ + int ix__; \ + if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \ + mmap_op_ix = 0; \ + ix__ = mmap_op_ix; \ + mmap_ops[ix__].type = ERTS_OP_TYPE_MMAP; \ + mmap_ops[ix__].result = NULL; \ + mmap_ops[ix__].in_size = (SZ); \ + mmap_ops[ix__].out_size = 0; \ + mmap_ops[ix__].old_ptr = NULL; \ + mmap_ops[ix__].old_size = 0; \ + } while (0) + +#define ERTS_MMAP_OP_END(PTR, SZ) \ + do { \ + int ix__ = mmap_op_ix; \ + mmap_ops[ix__].result = (PTR); \ + mmap_ops[ix__].out_size = (SZ); \ + } while (0) + +#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) \ + do { \ + erts_smp_mtx_lock(&mmap_state.mtx); \ + ERTS_MMAP_OP_START((IN_SZ)); \ + ERTS_MMAP_OP_END((RES), (OUT_SZ)); \ + erts_smp_mtx_unlock(&mmap_state.mtx); \ + } while (0) + +#define ERTS_MUNMAP_OP(PTR, SZ) \ + do { \ + int ix__; \ + if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \ + mmap_op_ix = 0; \ + ix__ = mmap_op_ix; \ + mmap_ops[ix__].type = ERTS_OP_TYPE_MUNMAP; \ + mmap_ops[ix__].result = NULL; \ + mmap_ops[ix__].in_size = 0; \ + mmap_ops[ix__].out_size = 0; \ + mmap_ops[ix__].old_ptr = (PTR); \ + mmap_ops[ix__].old_size = (SZ); \ + } while (0) + +#define ERTS_MUNMAP_OP_LCK(PTR, SZ) \ + do { \ + erts_smp_mtx_lock(&mmap_state.mtx); \ + ERTS_MUNMAP_OP((PTR), (SZ)); \ + erts_smp_mtx_unlock(&mmap_state.mtx); \ + } while (0) + +#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \ + do { \ + int ix__; \ + if (++mmap_op_ix >= ERTS_MMAP_OP_RINGBUF_SZ) \ + mmap_op_ix = 0; \ + ix__ = mmap_op_ix; \ + mmap_ops[ix__].type = ERTS_OP_TYPE_MREMAP; \ + mmap_ops[ix__].result = NULL; \ + mmap_ops[ix__].in_size = (IN_SZ); \ + mmap_ops[ix__].out_size = (OLD_SZ); \ + mmap_ops[ix__].old_ptr = (OLD_PTR); \ + mmap_ops[ix__].old_size = (OLD_SZ); \ + } while (0) + +#define ERTS_MREMAP_OP_END(PTR, SZ) \ + do { \ + int ix__ = mmap_op_ix; \ + mmap_ops[ix__].result = (PTR); \ + mmap_ops[mmap_op_ix].out_size = (SZ); \ + } while (0) + +#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) \ + do { \ + erts_smp_mtx_lock(&mmap_state.mtx); \ + ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ)); \ + ERTS_MREMAP_OP_END((RES), (OUT_SZ)); \ + erts_smp_mtx_unlock(&mmap_state.mtx); \ + } while (0) + +#define ERTS_MMAP_OP_ABORT() \ + do { \ + int ix__ = mmap_op_ix; \ + mmap_ops[ix__].type = ERTS_OP_TYPE_NONE; \ + mmap_ops[ix__].result = NULL; \ + mmap_ops[ix__].in_size = 0; \ + mmap_ops[ix__].out_size = 0; \ + mmap_ops[ix__].old_ptr = NULL; \ + mmap_ops[ix__].old_size = 0; \ + if (--mmap_op_ix < 0) \ + mmap_op_ix = ERTS_MMAP_OP_RINGBUF_SZ-1; \ + } while (0) + +#else + +#define ERTS_MMAP_OP_RINGBUF_INIT() +#define ERTS_MMAP_OP_START(SZ) +#define ERTS_MMAP_OP_END(PTR, SZ) +#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) +#define ERTS_MUNMAP_OP(PTR, SZ) +#define ERTS_MUNMAP_OP_LCK(PTR, SZ) +#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) +#define ERTS_MREMAP_OP_END(PTR, SZ) +#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) +#define ERTS_MMAP_OP_ABORT() + +#endif typedef struct { RBTNode snode; /* node in 'stree' */ @@ -167,7 +318,19 @@ static struct { int mmap_fd; #endif erts_smp_mtx_t mtx; - char *desc_free_list; + struct { + char *free_list; + char *unused_start; + char *unused_end; + char *new_area_hint; + } desc; + struct { + UWord free_seg_descs; + struct { + UWord curr; + UWord max; + } free_segs; + } no; struct { struct { UWord total; @@ -230,12 +393,15 @@ static struct { static void add_free_desc_area(char *start, char *end) { - if (end > start && sizeof(ErtsFreeSegDesc) <= end - start) { + ERTS_MMAP_ASSERT(end == (void *) 0 || end > start); + if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) { + UWord no; ErtsFreeSegDesc *prev_desc, *desc; char *desc_end; + no = 1; prev_desc = (ErtsFreeSegDesc *) start; - prev_desc->start = mmap_state.desc_free_list; + prev_desc->start = mmap_state.desc.free_list; desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc)); desc_end = start + 2*sizeof(ErtsFreeSegDesc); @@ -244,26 +410,61 @@ add_free_desc_area(char *start, char *end) prev_desc = desc; desc = (ErtsFreeSegDesc *) desc_end; desc_end += sizeof(ErtsFreeSegDesc); + no++; } - mmap_state.desc_free_list = (char *) prev_desc; + mmap_state.desc.free_list = (char *) prev_desc; + mmap_state.no.free_seg_descs += no; } } +static ErtsFreeSegDesc * +add_unused_free_desc_area(void) +{ + char *ptr; + if (!mmap_state.desc.unused_start) + return NULL; + + ERTS_MMAP_ASSERT(mmap_state.desc.unused_end); + ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE + <= mmap_state.desc.unused_end - mmap_state.desc.unused_start); + + ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE; + add_free_desc_area(mmap_state.desc.unused_start, ptr); + + if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE) + mmap_state.desc.unused_start = ptr; + else + mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL; + + ERTS_MMAP_ASSERT(mmap_state.desc.free_list); + return (ErtsFreeSegDesc *) mmap_state.desc.free_list; +} + static ERTS_INLINE ErtsFreeSegDesc * alloc_desc(void) { ErtsFreeSegDesc *res; - res = (ErtsFreeSegDesc *) mmap_state.desc_free_list; - if (res) - mmap_state.desc_free_list = res->start; + res = (ErtsFreeSegDesc *) mmap_state.desc.free_list; + if (!res) { + res = add_unused_free_desc_area(); + if (!res) + return NULL; + } + mmap_state.desc.free_list = res->start; + ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs); + mmap_state.no.free_segs.curr++; + if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr) + mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr; return res; } static ERTS_INLINE void free_desc(ErtsFreeSegDesc *desc) { - desc->start = mmap_state.desc_free_list; - mmap_state.desc_free_list = (char *) desc; + desc->start = mmap_state.desc.free_list; + mmap_state.desc.free_list = (char *) desc; + ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0); + mmap_state.no.free_segs.curr--; } static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode) @@ -1040,7 +1241,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) #endif static ERTS_INLINE void * -os_mmap(UWord size, int try_superalign) +os_mmap(void *hint_ptr, UWord size, int try_superalign) { #if HAVE_MMAP void *res; @@ -1050,7 +1251,7 @@ os_mmap(UWord size, int try_superalign) ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0); else #endif - res = mmap((void *) 0, size, ERTS_MMAP_PROT, + res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT, ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0); if (res == MAP_FAILED) return NULL; @@ -1179,37 +1380,90 @@ static void unreserve_noop(char *ptr, UWord size) #endif } -static ERTS_INLINE UWord +static UWord alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) { - UWord ad_sz; - char *new_end; + char *ptr; + ErtsFreeSegMap *da_map; ErtsFreeSegDesc *desc = alloc_desc(); if (desc) { insert_free_seg(map, desc, start, end); return 0; } - /* Use part of the free segment for descriptors */ + /* + * Ahh; ran out of free segment descriptors. + * + * First try to map a new page... + */ - if (map == &mmap_state.sa.map) { - ERTS_MMAP_SIZE_SC_SA_INC(ERTS_SUPERALIGNED_SIZE); - ad_sz = ERTS_SUPERALIGNED_SIZE; +#if ERTS_HAVE_OS_MMAP + ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0); + if (ptr) { + mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; + ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE); + add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE); + desc = alloc_desc(); + ERTS_MMAP_ASSERT(desc); + insert_free_seg(map, desc, start, end); + return 0; + } +#endif + + /* + * ...then try to find a good place in the supercarrier... + */ + da_map = &mmap_state.sua.map; + desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); + if (desc) { + if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE); + else + desc = NULL; + } else { - ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE); - ad_sz = ERTS_PAGEALIGNED_SIZE; + da_map = &mmap_state.sa.map; + desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); + if (desc) { + if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE); + else + desc = NULL; + } } + if (desc) { + char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE; + add_free_desc_area(desc->start, da_end); + if (da_end != desc->end) + resize_free_seg(da_map, desc, da_end, desc->end); + else { + delete_free_seg(da_map, desc); + free_desc(desc); + } - new_end = end - ad_sz; - ERTS_MMAP_ASSERT(start <= new_end); - if (start != new_end) { desc = alloc_desc(); ERTS_MMAP_ASSERT(desc); - insert_free_seg(map, desc, start, new_end); + insert_free_seg(map, desc, start, end); + return 0; } - return ad_sz; + /* + * ... and then as last resort use the first page of the + * free segment we are trying to insert for free descriptors. + */ + ptr = start + ERTS_PAGEALIGNED_SIZE; + ERTS_MMAP_ASSERT(ptr <= end); + + add_free_desc_area(start, ptr); + + if (ptr != end) { + desc = alloc_desc(); + ERTS_MMAP_ASSERT(desc); + insert_free_seg(map, desc, ptr, end); + } + + return ERTS_PAGEALIGNED_SIZE; } void * @@ -1226,6 +1480,8 @@ erts_mmap(Uint32 flags, UWord *sizep) erts_smp_mtx_lock(&mmap_state.mtx); + ERTS_MMAP_OP_START(*sizep); + if (!superaligned) { desc = lookup_free_seg(&mmap_state.sua.map, asize); if (desc) { @@ -1290,10 +1546,10 @@ erts_mmap(Uint32 flags, UWord *sizep) } if (superaligned) { - seg = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.top); + char *start = mmap_state.sa.top; + seg = (char *) ERTS_SUPERALIGNED_CEILING(start); - if (asize <= mmap_state.sua.bot - seg) { - char *start = mmap_state.sa.top; + if (asize + (seg - start) <= mmap_state.sua.bot - start) { end = seg + asize; if (!mmap_state.reserve_physical(start, (UWord) (end - start))) goto supercarrier_reserve_failure; @@ -1342,6 +1598,7 @@ erts_mmap(Uint32 flags, UWord *sizep) } } + ERTS_MMAP_OP_ABORT(); erts_smp_mtx_unlock(&mmap_state.mtx); } @@ -1349,15 +1606,15 @@ erts_mmap(Uint32 flags, UWord *sizep) /* Map using OS primitives */ if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) { if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) { - seg = os_mmap(asize, 0); + seg = os_mmap(NULL, asize, 0); if (!seg) - return NULL; + goto failure; } else { asize = ERTS_SUPERALIGNED_CEILING(*sizep); - seg = os_mmap(asize, 1); + seg = os_mmap(NULL, asize, 1); if (!seg) - return NULL; + goto failure; if (!ERTS_IS_SUPERALIGNED(seg)) { char *ptr; @@ -1365,9 +1622,9 @@ erts_mmap(Uint32 flags, UWord *sizep) os_munmap(seg, asize); - ptr = os_mmap(asize + ERTS_SUPERALIGNED_SIZE, 1); + ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1); if (!ptr) - return NULL; + goto failure; seg = (char *) ERTS_SUPERALIGNED_CEILING(ptr); sz = (UWord) (seg - ptr); @@ -1380,11 +1637,14 @@ erts_mmap(Uint32 flags, UWord *sizep) } } + ERTS_MMAP_OP_LCK(seg, *sizep, asize); ERTS_MMAP_SIZE_OS_INC(asize); *sizep = asize; return (void *) seg; } +failure: #endif + ERTS_MMAP_OP_LCK(NULL, *sizep, 0); *sizep = 0; return NULL; @@ -1401,6 +1661,7 @@ supercarrier_success: } #endif + ERTS_MMAP_OP_END(seg, asize); erts_smp_mtx_unlock(&mmap_state.mtx); *sizep = asize; @@ -1408,10 +1669,8 @@ supercarrier_success: supercarrier_reserve_failure: erts_smp_mtx_unlock(&mmap_state.mtx); - *sizep = 0; return NULL; - } void @@ -1419,9 +1678,11 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) { ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr)); ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size)); + if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) { ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap); #if ERTS_HAVE_OS_MMAP + ERTS_MUNMAP_OP_LCK(ptr, size); ERTS_MMAP_SIZE_OS_DEC(size); os_munmap(ptr, size); #endif @@ -1439,6 +1700,8 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) erts_smp_mtx_lock(&mmap_state.mtx); + ERTS_MUNMAP_OP(ptr, size); + if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) { map = &mmap_state.sa.map; @@ -1504,7 +1767,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) ERTS_MMAP_ASSERT(size >= ad_sz); unres_sz = size - ad_sz; if (unres_sz) - mmap_state.unreserve_physical((char *) ptr, unres_sz); + mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz); } } } @@ -1546,8 +1809,10 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) return new_ptr; } - if (ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) + if (ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) { + ERTS_MREMAP_OP_LCK(NULL, ptr, old_size, *sizep, old_size); return NULL; + } #if ERTS_HAVE_OS_MREMAP || ERTS_HAVE_GENUINE_OS_MMAP superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags); @@ -1555,6 +1820,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) if (superaligned) { asize = ERTS_SUPERALIGNED_CEILING(*sizep); if (asize == old_size && ERTS_IS_SUPERALIGNED(ptr)) { + ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize); *sizep = asize; return ptr; } @@ -1562,6 +1828,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) else { asize = ERTS_PAGEALIGNED_CEILING(*sizep); if (asize == old_size) { + ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize); *sizep = asize; return ptr; } @@ -1577,6 +1844,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) um_sz = (UWord) ((((char *) ptr) + old_size) - (char *) new_ptr); ERTS_MMAP_SIZE_OS_DEC(um_sz); os_munmap(new_ptr, um_sz); + ERTS_MREMAP_OP_LCK(ptr, ptr, old_size, *sizep, asize); *sizep = asize; return ptr; } @@ -1592,6 +1860,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) ERTS_MMAP_SIZE_OS_INC(asize - old_size); else ERTS_MMAP_SIZE_OS_DEC(old_size - asize); + ERTS_MREMAP_OP_LCK(new_ptr, ptr, old_size, *sizep, asize); *sizep = asize; return new_ptr; } @@ -1630,6 +1899,8 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) old_size, sizep); } + ERTS_MREMAP_OP_START(ptr, old_size, *sizep); + if (asize == old_size) { new_ptr = ptr; goto supercarrier_resize_success; @@ -1670,7 +1941,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) ERTS_MMAP_ASSERT(old_size - asize >= ad_sz); unres_sz = old_size - asize - ad_sz; if (unres_sz) - mmap_state.unreserve_physical(((char *) ptr) + asize, + mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz, unres_sz); goto supercarrier_resize_success; } @@ -1728,6 +1999,8 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep) } } } + + ERTS_MMAP_OP_ABORT(); erts_smp_mtx_unlock(&mmap_state.mtx); /* Failed to resize... */ @@ -1749,15 +2022,16 @@ supercarrier_resize_success: } #endif + ERTS_MREMAP_OP_END(new_ptr, asize); erts_smp_mtx_unlock(&mmap_state.mtx); *sizep = asize; return new_ptr; supercarrier_reserve_failure: - + ERTS_MREMAP_OP_END(NULL, old_size); erts_smp_mtx_unlock(&mmap_state.mtx); - *sizep = 0; + *sizep = old_size; return NULL; } @@ -1794,8 +2068,11 @@ erts_mmap_init(ErtsMMapInit *init) erl_exit(-1, "erts_mmap: Invalid pagesize: %bpu\n", pagesize); + ERTS_MMAP_OP_RINGBUF_INIT(); + erts_have_erts_mmap = 0; + mmap_state.supercarrier = 0; mmap_state.reserve_physical = reserve_noop; mmap_state.unreserve_physical = unreserve_noop; @@ -1851,7 +2128,7 @@ erts_mmap_init(ErtsMMapInit *init) * The whole supercarrier will by physically * reserved all the time. */ - start = os_mmap(sz, 1); + start = os_mmap(NULL, sz, 1); } if (!start) erl_exit(-1, @@ -1871,12 +2148,18 @@ erts_mmap_init(ErtsMMapInit *init) erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP; #endif + mmap_state.no.free_seg_descs = 0; + mmap_state.no.free_segs.curr = 0; + mmap_state.no.free_segs.max = 0; + mmap_state.size.supercarrier.total = 0; mmap_state.size.supercarrier.used.total = 0; mmap_state.size.supercarrier.used.sa = 0; mmap_state.size.supercarrier.used.sua = 0; mmap_state.size.os.used = 0; + mmap_state.desc.new_area_hint = NULL; + if (!start) { mmap_state.sa.bot = NULL; mmap_state.sua.top = NULL; @@ -1907,6 +2190,8 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.size.os.used += (UWord) (mmap_state.sa.bot - start); + mmap_state.desc.free_list = NULL; + if (end == (void *) 0) { /* * Very unlikely, but we need a guarantee @@ -1916,6 +2201,10 @@ erts_mmap_init(ErtsMMapInit *init) */ mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE; mmap_state.size.os.used += ERTS_PAGEALIGNED_SIZE; +#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION + if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE)) +#endif + add_free_desc_area(mmap_state.sua.top, end); } mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - mmap_state.sa.bot); @@ -1924,23 +2213,21 @@ erts_mmap_init(ErtsMMapInit *init) * Area before (and after) super carrier * will be used for free segment descritors. */ - mmap_state.desc_free_list = NULL; -#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (virtual_map && mmap_state.sa.bot - start > 0) - os_reserve_physical(start, mmap_state.sa.bot - start); -#endif - add_free_desc_area(start, mmap_state.sa.bot); #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (virtual_map && end - mmap_state.sua.top > 0) - os_reserve_physical(mmap_state.sua.top, end - mmap_state.sua.top); + if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start)) + erl_exit(-1, "erts_mmap: Failed to reserve physical memory for descriptors\n"); #endif - add_free_desc_area(mmap_state.sua.top, end); + mmap_state.desc.unused_start = start; + mmap_state.desc.unused_end = mmap_state.sa.bot; init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER); init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER); mmap_state.supercarrier = 1; erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP; + + mmap_state.desc.new_area_hint = end; + } #if !ERTS_HAVE_OS_MMAP diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 2474015bcb..c65973b3be 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -132,7 +132,7 @@ typedef struct { typedef struct cache_t_ cache_t; struct cache_t_ { - Uint size; + UWord size; void *seg; cache_t *next; cache_t *prev; @@ -408,7 +408,7 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) { c->prev = c; } -static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Uint flags) { +static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) { cache_t *c; ERTS_DBG_MK_CHK_THR_ACCESS(mk); @@ -496,7 +496,7 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size, Ui static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) { - Uint size = (UWord) *size_p; + UWord size = *size_p; ERTS_DBG_MK_CHK_THR_ACCESS(mk); @@ -505,7 +505,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag int i, ix = SIZE_TO_CACHE_AREA_IDX(size); char *seg; cache_t *c; - Uint csize; + UWord csize; ASSERT(IS_2POW(size)); @@ -542,10 +542,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag void *seg; cache_t *c; cache_t *best = NULL; - Uint bdiff = 0; - Uint csize; - Uint bad_max_abs = mk->ma->abs_max_cache_bad_fit; - Uint bad_max_rel = mk->ma->rel_max_cache_bad_fit; + UWord bdiff = 0; + UWord csize; + UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit; + UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit; erts_circleq_foreach(c, &(mk->cache_unpowered_node)) { csize = c->size; @@ -562,7 +562,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag mseg_cache_clear_node(c); erts_circleq_push_head(&(mk->cache_free), c); - *size_p = (UWord) csize; + *size_p = csize; return seg; @@ -593,7 +593,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag ASSERT((size % GET_PAGE_SIZE) == 0); ASSERT((best->size % GET_PAGE_SIZE) == 0); - *size_p = (UWord) size; + *size_p = size; return seg; @@ -822,7 +822,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size, ERTS_MSEG_DEALLOC_STAT(mk,size); - if (opt->cache && cache_bless_segment(mk, seg, (Uint) size, flags)) { + if (opt->cache && cache_bless_segment(mk, seg, size, flags)) { schedule_cache_check(ma); goto done; } -- cgit v1.2.3 From 19e47f24c1fe3dc996e836da0e5f99cea86acdbd Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 12 Sep 2013 17:52:33 +0200 Subject: erts: Refactor rbt_insert in erl_mmap --- erts/emulator/sys/common/erl_mmap.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 1f9168df28..1876398ec4 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -881,12 +881,12 @@ rbt_delete(RBTree* tree, RBTNode* del) static void -rbt_insert(enum SortOrder order, RBTree* tree, RBTNode* node) +rbt_insert(RBTree* tree, RBTNode* node) { #ifdef RBT_DEBUG ErtsFreeSegDesc *dbg_under=NULL, *dbg_over=NULL; #endif - ErtsFreeSegDesc* desc = node_to_desc(order, node); + ErtsFreeSegDesc* desc = node_to_desc(tree->order, node); char* seg_addr = desc->start; SWord seg_sz = desc->end - desc->start; @@ -902,9 +902,9 @@ rbt_insert(enum SortOrder order, RBTree* tree, RBTNode* node) else { RBTNode *x = tree->root; while (1) { - SWord diff = cmp_with_node(order, seg_sz, seg_addr, x); + SWord diff = cmp_with_node(tree->order, seg_sz, seg_addr, x); if (diff < 0) { - IF_RBT_DEBUG(dbg_over = node_to_desc(order, x)); + IF_RBT_DEBUG(dbg_over = node_to_desc(tree->order, x)); if (!x->left) { node->parent_and_color = parent_and_color(x, RED_FLG); x->left = node; @@ -914,7 +914,7 @@ rbt_insert(enum SortOrder order, RBTree* tree, RBTNode* node) } else { RBT_ASSERT(diff > 0); - IF_RBT_DEBUG(dbg_under = node_to_desc(order, x)); + IF_RBT_DEBUG(dbg_under = node_to_desc(tree->order, x)); if (!x->right) { node->parent_and_color = parent_and_color(x, RED_FLG); x->right = node; @@ -926,7 +926,7 @@ rbt_insert(enum SortOrder order, RBTree* tree, RBTNode* node) RBT_ASSERT(parent(node)); #ifdef RBT_DEBUG - if (order == ADDR_ORDER) { + if (tree->order == ADDR_ORDER) { RBT_ASSERT(!dbg_under || dbg_under->end < desc->start); RBT_ASSERT(!dbg_over || dbg_over->start > desc->end); } @@ -1130,8 +1130,8 @@ static void insert_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, { desc->start = start; desc->end = end; - rbt_insert(map->atree.order, &map->atree, &desc->anode); - rbt_insert(map->stree.order, &map->stree, &desc->snode); + rbt_insert(&map->atree, &desc->anode); + rbt_insert(&map->stree, &desc->snode); map->nseg++; } @@ -1151,7 +1151,7 @@ static void resize_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc, rbt_delete(&map->stree, &desc->snode); desc->start = start; desc->end = end; - rbt_insert(map->stree.order, &map->stree, &desc->snode); + rbt_insert(&map->stree, &desc->snode); } /* Delete existing free segment 'desc' from 'map'. -- cgit v1.2.3 From b9e82ba0be1364c64e90274d5e9bf37f78b676ee Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 13 Sep 2013 13:31:05 +0200 Subject: erts: Add HARD_DBG_MSEG --- erts/emulator/beam/erl_lock_check.c | 1 + erts/emulator/sys/common/erl_mmap.c | 142 +++++++++++++++++++++++++++++++++++- erts/emulator/sys/common/erl_mmap.h | 11 +++ erts/emulator/sys/common/erl_mseg.c | 6 ++ 4 files changed, 158 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 1e9cef3759..87efbdbc3e 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -186,6 +186,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { #endif #endif { "erts_alloc_hard_debug", NULL }, + { "hard_dbg_mseg", NULL }, { "erts_mmap", NULL } }; diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 1876398ec4..93a95e5eef 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -1039,7 +1039,7 @@ rbt_foreach_node(RBTree* tree, #endif } -#ifdef RBT_DEBUG +#if defined(RBT_DEBUG) || defined(HARD_DEBUG_MSEG) static RBTNode* rbt_prev_node(RBTNode* node) { RBTNode* x; @@ -1068,7 +1068,7 @@ static RBTNode* rbt_next_node(RBTNode* node) } return NULL; } -#endif /* RBT_DEBUG */ +#endif /* RBT_DEBUG || HARD_DEBUG_MSEG */ /* The API to keep track of a bunch of separated (free) segments @@ -2041,6 +2041,10 @@ int erts_mmap_in_supercarrier(void *ptr) return ERTS_MMAP_IN_SUPERCARRIER(ptr); } +#ifdef HARD_DEBUG_MSEG +static void hard_dbg_mseg_init(void); +#endif + void erts_mmap_init(ErtsMMapInit *init) { @@ -2233,6 +2237,10 @@ erts_mmap_init(ErtsMMapInit *init) #if !ERTS_HAVE_OS_MMAP mmap_state.no_os_mmap = 1; #endif + +#ifdef HARD_DEBUG_MSEG + hard_dbg_mseg_init(); +#endif } Eterm erts_mmap_info(Process* p) @@ -2494,3 +2502,133 @@ void test_it(void) } #endif /* FREE_SEG_API_SMOKE_TEST */ + + +#ifdef HARD_DEBUG_MSEG + +/* + * Debug stuff used by erl_mseg to check that it does the right thing. + * The reason for keeping it here is that we (ab)use the rb-tree code + * for keeping track of *allocated* segments. + */ + +typedef struct ErtsFreeSegDesc_fake_ { + /*RBTNode snode; Save memory by skipping unused size tree node */ + RBTNode anode; /* node in 'atree' */ + union { + char* start; + struct ErtsFreeSegDesc_fake_* next_free; + }u; + char* end; +}ErtsFreeSegDesc_fake; + +static ErtsFreeSegDesc_fake hard_dbg_mseg_desc_pool[10000]; +static ErtsFreeSegDesc_fake* hard_dbg_mseg_desc_first; +RBTree hard_dbg_mseg_tree; + +static erts_mtx_t hard_dbg_mseg_mtx; + +static void hard_dbg_mseg_init(void) +{ + ErtsFreeSegDesc_fake* p; + + erts_mtx_init(&hard_dbg_mseg_mtx, "hard_dbg_mseg"); + hard_dbg_mseg_tree.root = NULL; + hard_dbg_mseg_tree.order = ADDR_ORDER; + + p = &hard_dbg_mseg_desc_pool[(sizeof(hard_dbg_mseg_desc_pool) / + sizeof(*hard_dbg_mseg_desc_pool)) - 1]; + p->u.next_free = NULL; + while (--p >= hard_dbg_mseg_desc_pool) { + p->u.next_free = (p+1); + } + hard_dbg_mseg_desc_first = &hard_dbg_mseg_desc_pool[0]; +} + +static ErtsFreeSegDesc* hard_dbg_alloc_desc(void) +{ + ErtsFreeSegDesc_fake* p = hard_dbg_mseg_desc_first; + ERTS_ASSERT(p || !"HARD_DEBUG_MSEG: Out of mseg descriptors"); + hard_dbg_mseg_desc_first = p->u.next_free; + + /* Creative pointer arithmetic to return something that looks like + * a ErtsFreeSegDesc as long as we don't use the absent 'snode'. + */ + return (ErtsFreeSegDesc*) ((char*)p - offsetof(ErtsFreeSegDesc,anode)); +} + +static void hard_dbg_free_desc(ErtsFreeSegDesc* desc) +{ + ErtsFreeSegDesc_fake* p = (ErtsFreeSegDesc_fake*) &desc->anode; + memset(p, 0xfe, sizeof(*p)); + p->u.next_free = hard_dbg_mseg_desc_first; + hard_dbg_mseg_desc_first = p; +} + +static void check_seg_writable(void* seg, UWord sz) +{ + UWord* seg_end = (UWord*)((char*)seg + sz); + volatile UWord* p; + ERTS_ASSERT(ERTS_IS_PAGEALIGNED(seg)); + ERTS_ASSERT(ERTS_IS_PAGEALIGNED(sz)); + for (p=(UWord*)seg; pstart = (char*)seg; + desc->end = desc->start + sz - 1; /* -1 to allow adjacent segments in tree */ + rbt_insert(&hard_dbg_mseg_tree, &desc->anode); + prev = rbt_prev_node(&desc->anode); + next = rbt_next_node(&desc->anode); + ERTS_ASSERT(!prev || anode_to_desc(prev)->end < desc->start); + ERTS_ASSERT(!next || anode_to_desc(next)->start > desc->end); + } + erts_mtx_unlock(&hard_dbg_mseg_mtx); +} + +static ErtsFreeSegDesc* hard_dbg_lookup_seg_at(RBTree* tree, char* start) +{ + RBTNode* x = tree->root; + + while (x) { + ErtsFreeSegDesc* desc = anode_to_desc(x); + if (start < desc->start) { + x = x->left; + } + else if (start > desc->start) { + ERTS_ASSERT(start > desc->end); + x = x->right; + } + else + return desc; + } + return NULL; +} + +void hard_dbg_remove_mseg(void* seg, UWord sz) +{ + check_seg_writable(seg, sz); + erts_mtx_lock(&hard_dbg_mseg_mtx); + { + ErtsFreeSegDesc* desc = hard_dbg_lookup_seg_at(&hard_dbg_mseg_tree, (char*)seg); + ERTS_ASSERT(desc); + ERTS_ASSERT(desc->start == (char*)seg); + ERTS_ASSERT(desc->end == (char*)seg + sz - 1); + + rbt_delete(&hard_dbg_mseg_tree, &desc->anode); + hard_dbg_free_desc(desc); + } + erts_mtx_unlock(&hard_dbg_mseg_mtx); +} + +#endif /* HARD_DEBUG_MSEG */ diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 6cb51fb0b4..106459f872 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -110,4 +110,15 @@ Eterm erts_mmap_info(struct process*); # define ERTS_HAVE_OS_MMAP 1 #endif +/*#define HARD_DEBUG_MSEG*/ +#ifdef HARD_DEBUG_MSEG +# define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg +# define HARD_DBG_REMOVE_MSEG hard_dbg_remove_mseg +void hard_dbg_insert_mseg(void* seg, UWord sz); +void hard_dbg_remove_mseg(void* seg, UWord sz); +#else +# define HARD_DBG_INSERT_MSEG(SEG,SZ) +# define HARD_DBG_REMOVE_MSEG(SEG,SZ) +#endif + #endif /* ERL_MMAP_H__ */ diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index c65973b3be..13f8069cf5 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1356,6 +1356,7 @@ erts_mseg_alloc_opt(ErtsAlcType_t atype, UWord *size_p, Uint flags, const ErtsMs ERTS_DBG_MA_CHK_THR_ACCESS(ma); seg = mseg_alloc(ma, atype, size_p, flags, opt); ERTS_MSEG_UNLOCK(ma); + HARD_DBG_INSERT_MSEG(seg, *size_p); return seg; } @@ -1370,6 +1371,8 @@ erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, UWord size, Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); + + HARD_DBG_REMOVE_MSEG(seg, size); ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); mseg_dealloc(ma, atype, seg, size, flags, opt); @@ -1390,10 +1393,13 @@ erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *new_seg; + + HARD_DBG_REMOVE_MSEG(seg, old_size); ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, flags, opt); ERTS_MSEG_UNLOCK(ma); + HARD_DBG_INSERT_MSEG(new_seg, *new_size_p); return new_seg; } -- cgit v1.2.3 From 4ba6824a90943e74e8fdd02f3cb695931093bcca Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Fri, 13 Sep 2013 17:37:44 +0200 Subject: erts: Fix race bug in erts_munmap Must keep mutex to serialize (un)reserve ops. --- erts/emulator/sys/common/erl_mmap.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 93a95e5eef..317e3ec391 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -1762,12 +1762,12 @@ erts_munmap(Uint32 flags, void *ptr, UWord size) supercarrier_success: { UWord unres_sz; - erts_smp_mtx_unlock(&mmap_state.mtx); - ERTS_MMAP_ASSERT(size >= ad_sz); unres_sz = size - ad_sz; if (unres_sz) mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz); + + erts_smp_mtx_unlock(&mmap_state.mtx); } } } -- cgit v1.2.3 From 98c01224ff2c0dacc97613c080cc0f7268c6b2f1 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 24 Sep 2013 22:26:31 +0200 Subject: erts: Fix bug in lookup_free_seg that could return segments that are too small after being super aligned. --- erts/emulator/sys/common/erl_mmap.c | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 317e3ec391..237820d3ec 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -482,6 +482,14 @@ static ERTS_INLINE ErtsFreeSegDesc* node_to_desc(enum SortOrder order, RBTNode* return order==ADDR_ORDER ? anode_to_desc(node) : snode_to_desc(node); } +static ERTS_INLINE SWord usable_size(enum SortOrder order, + ErtsFreeSegDesc* desc) +{ + return ((order == SA_SZ_ADDR_ORDER) ? + ERTS_SUPERALIGNED_FLOOR(desc->end) - ERTS_SUPERALIGNED_CEILING(desc->start) + : desc->end - desc->start); +} + #ifdef HARD_DEBUG static ERTS_INLINE SWord cmp_nodes(enum SortOrder order, RBTNode* lhs, RBTNode* rhs) @@ -490,17 +498,7 @@ static ERTS_INLINE SWord cmp_nodes(enum SortOrder order, ErtsFreeSegDesc* rdesc = node_to_desc(order, rhs); RBT_ASSERT(lhs != rhs); if (order != ADDR_ORDER) { - SWord lsz, rsz, diff; - if (order == SA_SZ_ADDR_ORDER) { - lsz = ERTS_SUPERALIGNED_FLOOR(ldesc->end) - ERTS_SUPERALIGNED_CEILING(ldesc->start); - rsz = ERTS_SUPERALIGNED_FLOOR(rdesc->end) - ERTS_SUPERALIGNED_CEILING(rdesc->start); - } - else { - RBT_ASSERT(order == SZ_REVERSE_ADDR_ORDER); - lsz = ldesc->end - ldesc->start; - rsz = rdesc->end - rdesc->start; - } - diff = lsz - rsz; + SWord diff = usable_size(order, ldesc) - usable_size(order, rdesc); if (diff) return diff; } if (order != SZ_REVERSE_ADDR_ORDER) { @@ -517,13 +515,9 @@ static ERTS_INLINE SWord cmp_with_node(enum SortOrder order, { ErtsFreeSegDesc* rdesc; if (order != ADDR_ORDER) { - SWord rhs_sz, diff; + SWord diff; rdesc = snode_to_desc(rhs); - if (order == SA_SZ_ADDR_ORDER) - rhs_sz = ERTS_SUPERALIGNED_FLOOR(rdesc->end) - ERTS_SUPERALIGNED_CEILING(rdesc->start); - else - rhs_sz = rdesc->end - rdesc->start; - diff = sz - rhs_sz; + diff = sz - usable_size(order, rdesc); if (diff) return diff; } else @@ -1163,16 +1157,17 @@ static void delete_free_seg(ErtsFreeSegMap* map, ErtsFreeSegDesc* desc) map->nseg--; } -/* Lookup a free segment in 'map' with a size of at least 'need_sz' bytes. +/* Lookup a free segment in 'map' with a size of at least 'need_sz' usable bytes. */ static ErtsFreeSegDesc* lookup_free_seg(ErtsFreeSegMap* map, SWord need_sz) { RBTNode* x = map->stree.root; ErtsFreeSegDesc* best_desc = NULL; + const enum SortOrder order = map->stree.order; while (x) { ErtsFreeSegDesc* desc = snode_to_desc(x); - SWord seg_sz = desc->end - desc->start; + SWord seg_sz = usable_size(order, desc); if (seg_sz < need_sz) { x = x->right; -- cgit v1.2.3 From d6d531012957f8e3315d44c2bcb10938ab5d6e72 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Wed, 25 Sep 2013 17:23:55 +0200 Subject: erts: Rename erts_bld_atom_uint_2tup_list to *_uword_* and change from Uint to UWord values --- erts/emulator/beam/erl_trace.c | 38 ++++++++++++++++++------------------- erts/emulator/beam/erl_utils.h | 6 +++--- erts/emulator/beam/utils.c | 4 ++-- erts/emulator/sys/common/erl_mmap.c | 2 +- 4 files changed, 25 insertions(+), 25 deletions(-) diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index fa015ee4b9..ff7fdfcfca 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2184,7 +2184,7 @@ trace_gc(Process *p, Eterm what) AM_bin_old_vheap_block_size }; - Uint values[] = { + UWord values[] = { OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, HEAP_SIZE(p), MBUF_SIZE(p), @@ -2198,7 +2198,7 @@ trace_gc(Process *p, Eterm what) BIN_OLD_VHEAP_SZ(p) }; #define LOCAL_HEAP_SIZE \ - (sizeof(values)/sizeof(Eterm)) * \ + (sizeof(values)/sizeof(*values)) * \ (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \ 5/*4-tuple */ + TS_HEAP_WORDS DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); @@ -2206,7 +2206,7 @@ trace_gc(Process *p, Eterm what) Eterm* limit; #endif - ASSERT(sizeof(values)/sizeof(Uint) == sizeof(tags)/sizeof(Eterm)); + ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm)); UseTmpHeap(LOCAL_HEAP_SIZE,p); @@ -2214,9 +2214,9 @@ trace_gc(Process *p, Eterm what) hp = local_heap; #ifdef DEBUG size = 0; - (void) erts_bld_atom_uint_2tup_list(NULL, + (void) erts_bld_atom_uword_2tup_list(NULL, &size, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); size += 5/*4-tuple*/ + TS_SIZE(p); @@ -2229,9 +2229,9 @@ trace_gc(Process *p, Eterm what) ERTS_TRACE_FLAGS(p)); size = 0; - (void) erts_bld_atom_uint_2tup_list(NULL, + (void) erts_bld_atom_uword_2tup_list(NULL, &size, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); size += 5/*4-tuple*/ + TS_SIZE(p); @@ -2244,9 +2244,9 @@ trace_gc(Process *p, Eterm what) ASSERT(size <= LOCAL_HEAP_SIZE); #endif - msg = erts_bld_atom_uint_2tup_list(&hp, + msg = erts_bld_atom_uword_2tup_list(&hp, NULL, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); @@ -2415,7 +2415,7 @@ monitor_long_gc(Process *p, Uint time) { am_old_heap_size, am_heap_size }; - Eterm values[] = { + UWord values[] = { time, OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, HEAP_SIZE(p), @@ -2436,9 +2436,9 @@ monitor_long_gc(Process *p, Uint time) { #endif hsz = 0; - (void) erts_bld_atom_uint_2tup_list(NULL, + (void) erts_bld_atom_uword_2tup_list(NULL, &hsz, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); hsz += 5 /* 4-tuple */; @@ -2449,9 +2449,9 @@ monitor_long_gc(Process *p, Uint time) { hp_end = hp + hsz; #endif - list = erts_bld_atom_uint_2tup_list(&hp, + list = erts_bld_atom_uword_2tup_list(&hp, NULL, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); msg = TUPLE4(hp, am_monitor, p->common.id, am_long_gc, list); @@ -2489,7 +2489,7 @@ monitor_large_heap(Process *p) { am_old_heap_size, am_heap_size }; - Uint values[] = { + UWord values[] = { OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, HEAP_SIZE(p), MBUF_SIZE(p), @@ -2511,9 +2511,9 @@ monitor_large_heap(Process *p) { #endif hsz = 0; - (void) erts_bld_atom_uint_2tup_list(NULL, + (void) erts_bld_atom_uword_2tup_list(NULL, &hsz, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); hsz += 5 /* 4-tuple */; @@ -2524,9 +2524,9 @@ monitor_large_heap(Process *p) { hp_end = hp + hsz; #endif - list = erts_bld_atom_uint_2tup_list(&hp, + list = erts_bld_atom_uword_2tup_list(&hp, NULL, - sizeof(values)/sizeof(Uint), + sizeof(values)/sizeof(*values), tags, values); msg = TUPLE4(hp, am_monitor, p->common.id, am_large_heap, list); diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 80d29d554a..f85c7410c4 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-2013. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -175,8 +175,8 @@ Eterm erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[]); Eterm erts_bld_2tup_list(Uint **hpp, Uint *szp, Sint length, Eterm terms1[], Uint terms2[]); Eterm -erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp, - Sint length, Eterm atoms[], Uint uints[]); +erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm atoms[], UWord uints[]); Eterm erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length, Eterm atoms[], Uint uints1[], Uint uints2[]); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index bd2be7afca..0d75bbcc77 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -576,8 +576,8 @@ erts_bld_2tup_list(Uint **hpp, Uint *szp, } Eterm -erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp, - Sint length, Eterm atoms[], Uint uints[]) +erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm atoms[], UWord uints[]) { Sint i; Eterm res = THE_NON_VALUE; diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 237820d3ec..4392ec4f9c 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -2265,7 +2265,7 @@ Eterm erts_mmap_info(Process* p) hp = HAlloc(p, may_need); hp_end = hp + may_need; - list = erts_bld_atom_uint_2tup_list(&hp, NULL, + list = erts_bld_atom_uword_2tup_list(&hp, NULL, sizeof(values)/sizeof(*values), tags, values); -- cgit v1.2.3 From 8d5b9a53a1fd5e2264d705911af23cd484ccead0 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 26 Sep 2013 22:30:26 +0200 Subject: erts: Add erts_bld_tupleX macros for compile time argument checking --- erts/emulator/beam/erl_alloc.c | 12 ++++++------ erts/emulator/beam/erl_utils.h | 4 ++++ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index e30b3e7b51..ad1020d7d6 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -3060,13 +3060,13 @@ reply_alloc_info(void *vair) ? NIL : erts_mseg_info(0, NULL, NULL, hpp != NULL, hpp, szp)); - ainfo = erts_bld_tuple(hpp, szp, 3, - alloc_atom, - make_small(0), - ainfo); + ainfo = erts_bld_tuple3(hpp, szp, + alloc_atom, + make_small(0), + ainfo); #else - ainfo = erts_bld_tuple(hpp, szp, 2, alloc_atom, - am_false); + ainfo = erts_bld_tuple2(hpp, szp, alloc_atom, + am_false); #endif break; default: diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index f85c7410c4..292d135946 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -168,6 +168,10 @@ Eterm erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64); Eterm erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64); Eterm erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr); Eterm erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...); +#define erts_bld_tuple2(H,S,E1,E2) erts_bld_tuple(H,S,2,E1,E2) +#define erts_bld_tuple3(H,S,E1,E2,E3) erts_bld_tuple(H,S,3,E1,E2,E3) +#define erts_bld_tuple4(H,S,E1,E2,E3,E4) erts_bld_tuple(H,S,4,E1,E2,E3,E4) +#define erts_bld_tuple5(H,S,E1,E2,E3,E4,E5) erts_bld_tuple(H,S,5,E1,E2,E3,E4,E5) Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[]); Eterm erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len); #define erts_bld_string(hpp,szp,str) erts_bld_string_n(hpp,szp,str,strlen(str)) -- cgit v1.2.3 From 059d8b76011f960cc5938501a33002b051b0bca2 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 26 Sep 2013 22:36:34 +0200 Subject: erts: Add erts_mmap stats As part of erlang:system_info({allocator,mseg_alloc}) and erl_crash.dump --- erts/emulator/beam/erl_alloc.c | 14 ++- erts/emulator/beam/erl_bif_info.c | 2 +- erts/emulator/sys/common/erl_mmap.c | 193 +++++++++++++++++++++++++++++++++++- erts/emulator/sys/common/erl_mmap.h | 12 ++- erts/emulator/sys/common/erl_mseg.c | 5 +- erts/preloaded/ebin/erlang.beam | Bin 94156 -> 94244 bytes erts/preloaded/src/erlang.erl | 2 + 7 files changed, 222 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index ad1020d7d6..d8da616d05 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -2712,6 +2712,7 @@ erts_allocator_info(int to, void *arg) #if HAVE_ERTS_MSEG { + struct erts_mmap_info_struct emis; #ifdef ERTS_SMP int max = (int) erts_no_schedulers; #else @@ -2722,6 +2723,8 @@ erts_allocator_info(int to, void *arg) erts_print(to, arg, "=allocator:mseg_alloc[%d]\n", i); erts_mseg_info(i, &to, arg, 0, NULL, NULL); } + erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n"); + erts_mmap_info(&to, arg, NULL, NULL, &emis); } #endif @@ -2948,6 +2951,7 @@ reply_alloc_info(void *vair) Uint sz, *szp; ErlOffHeap *ohp = NULL; ErlHeapFragment *bp = NULL; + struct erts_mmap_info_struct emis; int i; Eterm (*info_func)(Allctr_t *, int, @@ -3064,11 +3068,19 @@ reply_alloc_info(void *vair) alloc_atom, make_small(0), ainfo); + + ai_list = erts_bld_cons(hpp, szp, + ainfo, ai_list); + ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis)); + ainfo = erts_bld_tuple3(hpp, szp, + alloc_atom, + erts_bld_atom(hpp,szp,"erts_mmap"), + ainfo); #else ainfo = erts_bld_tuple2(hpp, szp, alloc_atom, am_false); #endif - break; + break; default: alloc_atom = erts_bld_atom(hpp, szp, (char *) ERTS_ALC_A2AD(ai)); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 7aa439f2e6..5fbcbbe250 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3290,7 +3290,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(res); } else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) { - BIF_RET(erts_mmap_info(BIF_P)); + BIF_RET(erts_mmap_debug_info(BIF_P)); } } else if (is_tuple(BIF_ARG_1)) { diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 4392ec4f9c..60b32e8115 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -323,6 +323,7 @@ static struct { char *unused_start; char *unused_end; char *new_area_hint; + Uint reserved; } desc; struct { UWord free_seg_descs; @@ -2190,6 +2191,7 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.size.os.used += (UWord) (mmap_state.sa.bot - start); mmap_state.desc.free_list = NULL; + mmap_state.desc.reserved = 0; if (end == (void *) 0) { /* @@ -2204,6 +2206,7 @@ erts_mmap_init(ErtsMMapInit *init) if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE)) #endif add_free_desc_area(mmap_state.sua.top, end); + mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc); } mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - mmap_state.sa.bot); @@ -2218,6 +2221,8 @@ erts_mmap_init(ErtsMMapInit *init) #endif mmap_state.desc.unused_start = start; mmap_state.desc.unused_end = mmap_state.sa.bot; + mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start) + / sizeof(ErtsFreeSegDesc)); init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER); init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER); @@ -2238,7 +2243,192 @@ erts_mmap_init(ErtsMMapInit *init) #endif } -Eterm erts_mmap_info(Process* p) +static struct { + Eterm total; + Eterm total_sa; + Eterm total_sua; + Eterm used; + Eterm used_sa; + Eterm used_sua; + Eterm max; + Eterm allocated; + Eterm reserved; + Eterm sizes; + Eterm free_segs; + Eterm supercarrier; + Eterm os; + Eterm scs; + Eterm sco; + Eterm scrpm; + Eterm scmgc; + + int is_initialized; +}am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void init_atoms(void) +{ + AM_INIT(total); + AM_INIT(total_sa); + AM_INIT(total_sua); + AM_INIT(used); + AM_INIT(used_sa); + AM_INIT(used_sua); + AM_INIT(max); + AM_INIT(allocated); + AM_INIT(reserved); + AM_INIT(sizes); + AM_INIT(free_segs); + AM_INIT(supercarrier); + AM_INIT(os); + AM_INIT(scs); + AM_INIT(sco); + AM_INIT(scrpm); + AM_INIT(scmgc); + am.is_initialized = 1; +}; + + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +Eterm erts_mmap_info(int *print_to_p, + void *print_to_arg, + Eterm** hpp, Uint* szp, + struct erts_mmap_info_struct* emis) +{ + Eterm size_tags[] = { am.total, am.total_sa, am.total_sua, am.used, am.used_sa, am.used_sua }; + Eterm seg_tags[] = { am.used, am.max, am.allocated, am.reserved, am.used_sa, am.used_sua }; + Eterm group[2]; + Eterm group_tags[] = { am.sizes, am.free_segs }; + Eterm list[2]; + Eterm list_tags[2]; /* { am.supercarrier, am.os } */ + int lix; + Eterm res = THE_NON_VALUE; + + if (!hpp) { + erts_smp_mtx_lock(&mmap_state.mtx); + emis->sizes[0] = mmap_state.size.supercarrier.total; + emis->sizes[1] = mmap_state.sa.top - mmap_state.sa.bot; + emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot; + emis->sizes[3] = mmap_state.size.supercarrier.used.total; + emis->sizes[4] = mmap_state.size.supercarrier.used.sa; + emis->sizes[5] = mmap_state.size.supercarrier.used.sua; + + emis->segs[0] = mmap_state.no.free_segs.curr; + emis->segs[1] = mmap_state.no.free_segs.max; + emis->segs[2] = mmap_state.no.free_seg_descs; + emis->segs[3] = mmap_state.desc.reserved; + emis->segs[4] = mmap_state.sa.map.nseg; + emis->segs[5] = mmap_state.sua.map.nseg; + + emis->os_used = mmap_state.size.os.used; + erts_smp_mtx_unlock(&mmap_state.mtx); + } + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + if (mmap_state.supercarrier) { + const char* prefix = "supercarrier "; + erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]); + erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]); + erts_print(to, arg, "%stotal sua size: %bpu\n", prefix, emis->sizes[2]); + erts_print(to, arg, "%sused size: %bpu\n", prefix, emis->sizes[3]); + erts_print(to, arg, "%sused sa size: %bpu\n", prefix, emis->sizes[4]); + erts_print(to, arg, "%sused sua size: %bpu\n", prefix, emis->sizes[5]); + erts_print(to, arg, "%sused free segs: %bpu\n", prefix, emis->segs[0]); + erts_print(to, arg, "%smax free segs: %bpu\n", prefix, emis->segs[1]); + erts_print(to, arg, "%sallocated free segs: %bpu\n", prefix, emis->segs[2]); + erts_print(to, arg, "%sreserved free segs: %bpu\n", prefix, emis->segs[3]); + erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]); + erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]); + } + if (!mmap_state.no_os_mmap) { + erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used); + } + } + + + if (hpp || szp) { + if (!am.is_initialized) { + init_atoms(); + } + + lix = 0; + if (mmap_state.supercarrier) { + group[0] = erts_bld_atom_uword_2tup_list(hpp, szp, + sizeof(size_tags)/sizeof(Eterm), + size_tags, emis->sizes); + group[1] = erts_bld_atom_uword_2tup_list(hpp, szp, + sizeof(seg_tags)/sizeof(Eterm), + seg_tags, emis->segs); + list[lix] = erts_bld_2tup_list(hpp, szp, 2, group_tags, group); + list_tags[lix] = am.supercarrier; + lix++; + } + + if (!mmap_state.no_os_mmap) { + group[0] = erts_bld_atom_uword_2tup_list(hpp, szp, + 1, &am.used, &emis->os_used); + list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group); + list_tags[lix] = am.os; + lix++; + } + res = erts_bld_2tup_list(hpp, szp, lix, list_tags, list); + } + return res; +} + +Eterm erts_mmap_info_options(char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + const UWord scs = mmap_state.sua.top - mmap_state.sa.bot; + const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false; + const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false; + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, arg, "%sscs: %bpu\n", prefix, scs); + if (mmap_state.supercarrier) { + erts_print(to, arg, "%ssco: %T\n", prefix, sco); + erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm); + erts_print(to, arg, "%sscmgc: %beu\n", prefix, mmap_state.desc.reserved); + } + } + + if (hpp || szp) { + if (!am.is_initialized) { + init_atoms(); + } + + res = NIL; + if (mmap_state.supercarrier) { + add_2tup(hpp, szp, &res, am.scmgc, + erts_bld_uint(hpp,szp, mmap_state.desc.reserved)); + add_2tup(hpp, szp, &res, am.scrpm, scrpm); + add_2tup(hpp, szp, &res, am.sco, sco); + } + add_2tup(hpp, szp, &res, am.scs, erts_bld_uword(hpp, szp, scs)); + } + return res; +} + + +Eterm erts_mmap_debug_info(Process* p) { if (mmap_state.supercarrier) { ERTS_DECL_AM(sabot); @@ -2283,6 +2473,7 @@ Eterm erts_mmap_info(Process* p) } } + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Debug functions * \* */ diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 106459f872..e6934dbb26 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -57,8 +57,18 @@ void erts_munmap(Uint32 flags, void *ptr, UWord size); void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep); int erts_mmap_in_supercarrier(void *ptr); void erts_mmap_init(ErtsMMapInit*); +struct erts_mmap_info_struct +{ + UWord sizes[6]; + UWord segs[6]; + UWord os_used; +}; +Eterm erts_mmap_info(int *print_to_p, void *print_to_arg, + Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*); +Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg, + Uint **hpp, Uint *szp); struct process; -Eterm erts_mmap_info(struct process*); +Eterm erts_mmap_debug_info(struct process*); #define ERTS_SUPERALIGNED_SIZE \ (1 << ERTS_MMAP_SUPERALIGNED_BITS) diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index 13f8069cf5..b165f76c96 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1070,7 +1070,9 @@ info_options(ErtsMsegAllctr_t *ma, Uint **hpp, Uint *szp) { - Eterm res = THE_NON_VALUE; + Eterm res; + + res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp); if (print_to_p) { int to = *print_to_p; @@ -1085,7 +1087,6 @@ info_options(ErtsMsegAllctr_t *ma, if (!atoms_initialized) init_atoms(ma); - res = NIL; add_2tup(hpp, szp, &res, am.mcs, bld_uint(hpp, szp, ma->max_cache_size)); diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam index f1791200e0..5a9ffa89d1 100644 Binary files a/erts/preloaded/ebin/erlang.beam and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index d40ee7c59a..2b6760c675 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -3499,6 +3499,8 @@ mk_res_list([]) -> mk_res_list([Alloc | Rest]) -> [{Alloc, []} | mk_res_list(Rest)]. +insert_instance(I, N, Rest) when erlang:is_atom(N) -> + [{N, I} | Rest]; insert_instance(I, N, []) -> [{instance, N, I}]; insert_instance(I, N, [{instance, M, _}|_] = Rest) when N < M -> -- cgit v1.2.3 From 6baa1883a9c7f4d9b4be76d1375cf8b2cc614797 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 27 Sep 2013 14:11:54 +0200 Subject: Fix broken handling of default values for BIT STRINGs For DER/PER/UPER, a value equal to the DEFAULT is not supposed to be encoded. BIT STRINGs values can be represented as Erlang terms in four different ways: as an integer, as a list of zeroes and ones, as a {Unused,Binary} tuple, or as an Erlang bitstring. When encoding a BIT STRING, only certain representations of BIT STRINGs values were recognized. All representations must be recognized. When decoding a DEFAULT value for a BIT STRING, the actual value given in the decoding would be either an integer or a list of zeroes and one (depending on how the literal was written in the specification). We expect that the default value should be in the same representation as any other BIT STRING value (i.e. by default an Erlang bitstring, or a list if the 'legacy_bitstring' option has been given, or as compact bitstring if 'compact_bitstring' has been given). --- lib/asn1/src/asn1ct_check.erl | 105 +++++--------- lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl | 3 +- lib/asn1/src/asn1ct_constructed_per.erl | 71 ++++++--- lib/asn1/src/asn1ct_gen.erl | 44 +++++- lib/asn1/src/asn1ct_imm.erl | 23 ++- lib/asn1/src/asn1rtt_check.erl | 91 +++++++----- lib/asn1/src/asn1rtt_per_common.erl | 41 ++++++ lib/asn1/test/asn1_SUITE.erl | 36 ++--- lib/asn1/test/asn1_SUITE_data/Default.asn | 3 +- lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 | 8 +- lib/asn1/test/testParamBasic.erl | 7 +- lib/asn1/test/testPrimStrings.erl | 41 +++++- lib/asn1/test/testSeqSetDefaultVal.erl | 191 ++++++++++++++++++++++--- 13 files changed, 487 insertions(+), 177 deletions(-) diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index eddcda0018..04227fd23b 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2534,89 +2534,54 @@ normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> normalize_integer(_,Int,_) -> exit({'Unknown INTEGER value',Int}). -normalize_bitstring(S,Value,Type)-> - %% There are four different Erlang formats of BIT STRING: - %% 1 - a list of ones and zeros. - %% 2 - a list of atoms. - %% 3 - as an integer, for instance in hexadecimal form. - %% 4 - as a tuple {Unused, Binary} where Unused is an integer - %% and tells how many bits of Binary are unused. - %% - %% normalize_bitstring/3 transforms Value according to: - %% A to 3, - %% B to 1, - %% C to 1 or 3 - %% D to 2, - %% Value can be on format: - %% A - {hstring, String}, where String is a hexadecimal string. - %% B - {bstring, String}, where String is a string on bit format - %% C - #'Externalvaluereference'{value=V}, where V is a defined value - %% D - list of #'Externalvaluereference', where each value component - %% is an identifier corresponing to NamedBits in Type. - %% E - list of ones and zeros, if Value already is normalized. +%% normalize_bitstring(S, Value, Type) -> bitstring() +%% Convert a literal value for a BIT STRING to an Erlang bit string. +%% +normalize_bitstring(S, Value, Type)-> case Value of {hstring,String} when is_list(String) -> - hstring_to_int(String); + hstring_to_bitstring(String); {bstring,String} when is_list(String) -> - bstring_to_bitlist(String); - Rec when is_record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,Type, - fun normalize_bitstring/3,[]); + bstring_to_bitstring(String); + #'Externalvaluereference'{} -> + get_normalized_value(S, Value, Type, + fun normalize_bitstring/3, []); RecList when is_list(RecList) -> - case Type of - NBL when is_list(NBL) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keysearch(Name,1,NBL) of - {value,{Name,_}} -> - Name; - Other -> - throw({error,Other}) - end; - (I) when I =:= 1; I =:= 0 -> - I; - (Other) -> - throw({error,Other}) - end, - case catch lists:map(F,RecList) of - {error,Reason} -> - asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [Reason],S, - "default value not " - "compatible with type definition"), - Value; - NewList -> - NewList - end; - _ -> + F = fun(#'Externalvaluereference'{value=Name}) -> + case lists:keymember(Name, 1, Type) of + true -> Name; + false -> throw({error,false}) + end; + (Name) when is_atom(Name) -> + %% Already normalized. + Name; + (Other) -> + throw({error,Other}) + end, + try + lists:map(F, RecList) + catch + throw:{error,Reason} -> asn1ct:warning("default value not " "compatible with type definition ~p~n", - [RecList],S, + [Reason],S, "default value not " "compatible with type definition"), Value end; - {Name,String} when is_atom(Name) -> - normalize_bitstring(S,String,Type); - Other -> - asn1ct:warning("illegal default value ~p~n",[Other],S, - "illegal default value"), - Value + Bs when is_bitstring(Bs) -> + %% Already normalized. + Bs end. -hstring_to_int(L) when is_list(L) -> - hstring_to_int(L,0). -hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> - hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; -hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> - hstring_to_int(T,(Acc bsl 4) + (H - $0)); -hstring_to_int([],Acc) -> - Acc. +hstring_to_bitstring(L) -> + << <<(hex_to_int(D)):4>> || D <- L >>. -bstring_to_bitlist([H|T]) when H == $0; H == $1 -> - [H - $0 | bstring_to_bitlist(T)]; -bstring_to_bitlist([]) -> - []. +bstring_to_bitstring(L) -> + << <<(D-$0):1>> || D <- L >>. + +hex_to_int(D) when $0 =< D, D =< $9 -> D - $0; +hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). %% normalize_octetstring/1 changes representation of input Value to a %% list of octets. diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 8359b81b33..a38da8bcc2 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -1155,7 +1155,8 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> emit([indent(4),"_ ->",nl]), case OptOrMand of - {'DEFAULT', Def} -> + {'DEFAULT', Def0} -> + Def = asn1ct_gen:conform_value(Type, Def0), emit([indent(8),"{",{asis,Def},",",{prev,tlv},"}",nl]); 'OPTIONAL' -> emit([indent(8),"{ asn1_NOVALUE, ",{prev,tlv},"}",nl]) diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 8d4afc0a0b..4672f7edd3 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -770,8 +770,10 @@ optionals(L) -> optionals(L,[],2). optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) -> optionals(Rest, [Pos|Acc], Pos+1); -optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest], Acc, Pos) -> - optionals(Rest, [{Pos,Val}|Acc], Pos+1); +optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest], + Acc, Pos) -> + Vals = def_values(T, Val), + optionals(Rest, [{Pos,Vals}|Acc], Pos+1); optionals([#'ComponentType'{}|Rest], Acc, Pos) -> optionals(Rest, Acc, Pos+1); optionals([], Acc, _) -> @@ -888,7 +890,8 @@ gen_enc_components_call1(Erule,TopType, optional -> asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1); {default,Def} -> - asn1ct_imm:enc_absent(Element, [asn1_DEFAULT,Def], Imm1) + DefValues = def_values(Type, Def), + asn1ct_imm:enc_absent(Element, DefValues, Imm1) end, Imm = case Imm2 of [] -> []; @@ -899,6 +902,38 @@ gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) -> ImmList = lists:reverse(Acc), {ImmList,Pos}. +def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> + #typedef{typespec=T} = asn1_db:dbget(Mod, Type), + def_values(T, Def); +def_values(#type{def={'BIT STRING',[]}}, Bs) when is_bitstring(Bs) -> + ListBs = [B || <> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Sz = bit_size(Bs), + Compact = case 8 - Sz rem 8 of + 8 -> + {0,Bs}; + Unused -> + {Unused,<>} + end, + [asn1_DEFAULT,Bs,Compact,ListBs,IntBs]; +def_values(#type{def={'BIT STRING',[_|_]=Ns}}, List) when is_list(List) -> + Bs = asn1ct_gen:named_bitstring_value(List, Ns), + ListBs = [B || <> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Args = [List,Bs,ListBs,IntBs], + {call,per_common,is_default_bitstring,Args}; +def_values(#type{def={'INTEGER',Ns}}, Def) -> + [asn1_DEFAULT,Def|case lists:keyfind(Def, 2, Ns) of + false -> []; + {Val,Def} -> [Val] + end]; +def_values(_, Def) -> + [asn1_DEFAULT,Def]. + gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) -> Imm0 = gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc), @@ -1207,7 +1242,8 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> {[],[]}; -comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> +comp_call_pre_post(noext, Prop, _, Type, TextPos, + OptTable, NumOptionals, Ext) -> %% OPTIONAL or DEFAULT OptPos = get_optionality_pos(TextPos, OptTable), Element = case NumOptionals - OptPos of @@ -1225,7 +1261,7 @@ comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> emit([";",nl, "0 ->",nl, "{"]), - gen_dec_component_no_val(Ext, Prop), + gen_dec_component_no_val(Ext, Type, Prop), emit([",",{curr,bytes},"}",nl, "end"]), St @@ -1247,10 +1283,10 @@ comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> components=ExtGroupCompList2}} when is_integer(Number2)-> emit("{extAddGroup,"), - gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2), + gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), emit("}"); _ -> - gen_dec_component_no_val(Ext, Prop) + gen_dec_component_no_val(Ext, Type, Prop) end, emit([",",{curr,bytes},"}",nl, "end"]), @@ -1265,21 +1301,22 @@ is_mandatory_predef_tab_c(_, _, {"got objfun through args","ObjFun"}) -> is_mandatory_predef_tab_c(_,_,_) -> true. -gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])-> - gen_dec_component_no_val(Ext,Prop), +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}])-> + gen_dec_component_no_val(Ext, Type, Prop), ok; -gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}|Rest])-> - gen_dec_component_no_val(Ext,Prop), - emit({","}), - gen_dec_extaddGroup_no_val(Ext,Rest); -gen_dec_extaddGroup_no_val(_, []) -> +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}|Rest])-> + gen_dec_component_no_val(Ext, Type, Prop), + emit(","), + gen_dec_extaddGroup_no_val(Ext, Type, Rest); +gen_dec_extaddGroup_no_val(_, _, []) -> ok. -gen_dec_component_no_val(_,{'DEFAULT',DefVal}) -> +gen_dec_component_no_val(_, Type, {'DEFAULT',DefVal0}) -> + DefVal = asn1ct_gen:conform_value(Type, DefVal0), emit([{asis,DefVal}]); -gen_dec_component_no_val(_,'OPTIONAL') -> +gen_dec_component_no_val(_, _, 'OPTIONAL') -> emit({"asn1_NOVALUE"}); -gen_dec_component_no_val({ext,_,_},mandatory) -> +gen_dec_component_no_val({ext,_,_}, _, mandatory) -> emit({"asn1_NOVALUE"}). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 3452d29085..30d337635b 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -33,7 +33,9 @@ insert_once/2, ct_gen_module/1, index2suffix/1, - get_record_name_prefix/0]). + get_record_name_prefix/0, + conform_value/2, + named_bitstring_value/2]). -export([pgen/5, mk_var/1, un_hyphen_var/1]). @@ -1485,8 +1487,14 @@ gen_prim_check_call(PrimType, Default, Element, Type) -> end, check_call(check_int, [Default,Element,{asis,NNL}]); 'BIT STRING' -> - {_,NBL} = Type#type.def, - check_call(check_bitstring, [Default,Element,{asis,NBL}]); + case Type#type.def of + {_,[]} -> + check_call(check_bitstring, + [Default,Element]); + {_,[_|_]=NBL} -> + check_call(check_named_bitstring, + [Default,Element,{asis,NBL}]) + end; 'OCTET STRING' -> check_call(check_octetstring, [Default,Element]); 'NULL' -> @@ -1640,9 +1648,33 @@ unify_if_string(PrimType) -> Other -> Other end. - - - +conform_value(#type{def={'BIT STRING',[]}}, Bs) -> + case asn1ct:get_bit_string_format() of + compact when is_binary(Bs) -> + {0,Bs}; + compact when is_bitstring(Bs) -> + Sz = bit_size(Bs), + Unused = 8 - bit_size(Bs), + {Unused,<>}; + legacy -> + [B || <> <= Bs]; + bitstring when is_bitstring(Bs) -> + Bs + end; +conform_value(_, Value) -> Value. + +named_bitstring_value(List, Names) -> + Int = lists:foldl(fun(N, A) -> + {N,Pos} = lists:keyfind(N, 1, Names), + A bor (1 bsl Pos) + end, 0, List), + named_bitstring_value_1(<<>>, Int). + +named_bitstring_value_1(Bs, 0) -> + Bs; +named_bitstring_value_1(Bs, Int) -> + B = Int band 1, + named_bitstring_value_1(<>, Int bsr 1). get_inner(A) when is_atom(A) -> A; get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 892178f61b..dfa4ce0d6b 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -319,14 +319,22 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> {'cond',[[{eq,Bitmap,0}], ['_'|Length ++ PutBits]],{var,"Extensions"}}]. -per_enc_optional(Val0, {Pos,Def}, _Aligned) when is_integer(Pos) -> +per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), + is_list(DefVals) -> Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), {B,[Val]} = mk_vars(Val1, []), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{'cond',[[{eq,Val,asn1_DEFAULT},Zero], - [{eq,Val,Def},Zero], - ['_',One]]}]; + B++[{'cond', + [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; +per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> + Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), + {B,[Val,Tmp]} = mk_vars(Val1, [tmp]), + Zero = {put_bits,0,1,[1]}, + One = {put_bits,1,1,[1]}, + B++[{call,M,F,[Val|A],Tmp}, + {'cond', + [[{eq,Tmp,true},Zero],['_',One]]}]; per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), {B,[Val]} = mk_vars(Val1, []), @@ -352,7 +360,12 @@ per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> PreBlock ++ EncLen ++ Lc end. -enc_absent(Val0, AbsVals, Body) -> +enc_absent(Val0, {call,M,F,A}, Body) -> + {B,[Var,Tmp]} = mk_vars(Val0, [tmp]), + B++[{call,M,F,[Var|A],Tmp}, + {'cond', + [[{eq,Tmp,true}],['_'|Body]]}]; +enc_absent(Val0, AbsVals, Body) when is_list(AbsVals) -> {B,[Var]} = mk_vars(Val0, []), Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]], B++build_cond(Cs). diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl index e78b65a8fb..be4f9c8bff 100644 --- a/lib/asn1/src/asn1rtt_check.erl +++ b/lib/asn1/src/asn1rtt_check.erl @@ -20,7 +20,7 @@ -export([check_bool/2, check_int/3, - check_bitstring/3, + check_bitstring/2,check_named_bitstring/3, check_octetstring/2, check_null/2, check_objectidentifier/2, @@ -50,31 +50,54 @@ check_int(DefValue, Value, NNL) when is_atom(Value) -> check_int(DefaultValue, _Value, _) -> throw({error,DefaultValue}). -%% Two equal lists or integers -check_bitstring(_, asn1_DEFAULT, _) -> +%% check_bitstring(Default, UserBitstring) -> true|false +%% Default = bitstring() +%% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring() +check_bitstring(_, asn1_DEFAULT) -> true; -check_bitstring(V, V, _) -> - true; -%% Default value as a list of 1 and 0 and user value as an integer -check_bitstring(L=[H|T], Int, _) when is_integer(Int), is_integer(H) -> - case bit_list_to_int(L, length(T)) of - Int -> true; - _ -> throw({error,L,Int}) +check_bitstring(DefVal, {Unused,Binary}) -> + %% User value in compact format. + Sz = bit_size(Binary) - Unused, + <> = Binary, + check_bitstring(DefVal, Val); +check_bitstring(DefVal, Val) when is_bitstring(Val) -> + case Val =:= DefVal of + false -> throw(error); + true -> true end; -%% Default value as an integer, val as list -check_bitstring(Int, Val, NBL) when is_integer(Int), is_list(Val) -> - BL = int_to_bit_list(Int, [], length(Val)), - check_bitstring(BL, Val, NBL); +check_bitstring(Def, Val) when is_list(Val) -> + check_bitstring_list(Def, Val); +check_bitstring(Def, Val) when is_integer(Val) -> + check_bitstring_integer(Def, Val). + +check_bitstring_list(<>, [H|T2]) -> + check_bitstring_list(T1, T2); +check_bitstring_list(<<>>, []) -> + true; +check_bitstring_list(_, _) -> + throw(error). + +check_bitstring_integer(<>, Int) when H =:= Int band 1 -> + check_bitstring_integer(T1, Int bsr 1); +check_bitstring_integer(<<>>, 0) -> + true; +check_bitstring_integer(_, _) -> + throw(error). + +check_named_bitstring(_, asn1_DEFAULT, _) -> + true; +check_named_bitstring(V, V, _) -> + true; %% Default value and user value as lists of ones and zeros -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> L2new = remove_trailing_zeros(L2), - check_bitstring(L1, L2new, NBL); + check_named_bitstring(L1, L2new, NBL); %% Default value as a list of 1 and 0 and user value as a list of atoms -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> L3 = bit_list_to_nbl(L1, NBL, 0, []), - check_bitstring(L3, L2, NBL); + check_named_bitstring(L3, L2, NBL); %% Both default value and user value as a list of atoms -check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) +check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _) when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) -> case lists:member(H1, L2) of true -> @@ -82,27 +105,29 @@ check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) false -> throw({error,L2}) end; %% Default value as a list of atoms and user value as a list of 1 and 0 -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> L3 = bit_list_to_nbl(L2, NBL, 0, []), - check_bitstring(L1, L3, NBL); + check_named_bitstring(L1, L3, NBL); %% User value in compact format -check_bitstring(DefVal,CBS={_,_}, NBL) -> +check_named_bitstring(DefVal,CBS={_,_}, NBL) -> NewVal = cbs_to_bit_list(CBS), - check_bitstring(DefVal, NewVal, NBL); -check_bitstring(DV, V, _) -> + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a binary +check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) -> + NewVal = cbs_to_bit_list({0,CBS}), + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a bitstring +check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) -> + BitSize = bit_size(CBS), + Unused = 8 - (BitSize band 7), + NewVal = cbs_to_bit_list({Unused,<>}), + check_named_bitstring(DefVal, NewVal, NBL); +check_named_bitstring(DV, V, _) -> throw({error,DV,V}). - -bit_list_to_int([0|Bs], ShL)-> - bit_list_to_int(Bs, ShL-1) + 0; -bit_list_to_int([1|Bs], ShL) -> - bit_list_to_int(Bs, ShL-1) + (1 bsl ShL); -bit_list_to_int([], _) -> - 0. - int_to_bit_list(0, Acc, 0) -> Acc; -int_to_bit_list(Int, Acc, Len) -> +int_to_bit_list(Int, Acc, Len) when Len > 0 -> int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1). bit_list_to_nbl([0|T], NBL, Pos, Acc) -> diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 9e9fd87ec3..3309e6a4ca 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -37,6 +37,7 @@ bitstring_from_positions/1,bitstring_from_positions/2, to_bitstring/1,to_bitstring/2, to_named_bitstring/1,to_named_bitstring/2, + is_default_bitstring/5, extension_bitmap/3]). -define('16K',16384). @@ -271,6 +272,36 @@ to_named_bitstring(Val, Lb) -> %% for correctness, not speed. adjust_trailing_zeroes(to_bitstring(Val), Lb). +is_default_bitstring(asn1_DEFAULT, _, _, _, _) -> + true; +is_default_bitstring({Unused,Bin}, V0, V1, V2, V3) when is_integer(Unused) -> + %% Convert compact bitstring to a bitstring. + Sz = bit_size(Bin) - Unused, + <> = Bin, + is_default_bitstring(Bs, V0, V1, V2, V3); +is_default_bitstring(Named, Named, _, _, _) -> + true; +is_default_bitstring(Bs, _, Bs, _, _) -> + true; +is_default_bitstring(List, _, _, List, _) -> + true; +is_default_bitstring(Int, _, _, _, Int) -> + true; +is_default_bitstring(Val, _, Def, _, _) when is_bitstring(Val) -> + Sz = bit_size(Def), + case Val of + <> -> + NumZeroes = bit_size(T), + case T of + <<0:NumZeroes>> -> true; + _ -> false + end; + _ -> + false + end; +is_default_bitstring(Val, _, _, List, _) when is_list(Val) -> + is_default_bitstring_list(List, Val); +is_default_bitstring(_, _, _, _, _) -> false. extension_bitmap(Val, Pos, Limit) -> extension_bitmap(Val, Pos, Limit, 0). @@ -447,6 +478,16 @@ ntz(Byte) -> 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0}, element(Byte+1, T). +is_default_bitstring_list([H|Def], [H|Val]) -> + is_default_bitstring_list(Def, Val); +is_default_bitstring_list([], []) -> + true; +is_default_bitstring_list([], [_|_]=Val) -> + lists:all(fun(0) -> true; + (_) -> false + end, Val); +is_default_bitstring_list(_, _) -> false. + extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit -> Acc; extension_bitmap(Val, Pos, Limit, Acc) -> diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 61b360ddf2..83bd66a631 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -96,7 +96,6 @@ groups() -> testChoTypeRefSeq, testChoTypeRefSet, testMultipleLevels, - testDef, testOpt, testSeqDefault, % Uses 'External' @@ -141,9 +140,9 @@ groups() -> testDeepTConstr, testExport, testImport, - % Uses 'ParamBasic' - {group, [], [testParamBasic, - testDER]}, + testParamBasic, + testDER, + testDEFAULT, testMvrasn6, testContextSwitchingTypes, testOpenTypeImplicitTag, @@ -326,20 +325,21 @@ testCompactBitString(Config, Rule, Opts) -> [Rule, compact_bit_string|Opts]), testCompactBitString:otp_4869(Rule). -testPrimStrings(Config) -> test(Config, fun testPrimStrings/3). +testPrimStrings(Config) -> + test(Config, fun testPrimStrings/3, [ber,{ber,[der]},per,uper]). testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]), - testPrimStrings_cases(Rule), + testPrimStrings_cases(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [legacy_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:more_strings(Rule). -testPrimStrings_cases(Rule) -> - testPrimStrings:bit_string(Rule), +testPrimStrings_cases(Rule, Opts) -> + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:octet_string(Rule), testPrimStrings:numeric_string(Rule), testPrimStrings:other_strings(Rule), @@ -429,6 +429,13 @@ testDef(Config, Rule, Opts) -> asn1_test_lib:compile("Def", Config, [Rule|Opts]), testDef:main(Rule). +testDEFAULT(Config) -> + test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]). +testDEFAULT(Config, Rule, Opts) -> + asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]), + testDef:main(Rule), + testSeqSetDefaultVal:main(Rule, Opts). + testOpt(Config) -> test(Config, fun testOpt/3). testOpt(Config, Rule, Opts) -> asn1_test_lib:compile("Opt", Config, [Rule|Opts]), @@ -516,7 +523,8 @@ testSetDefault(Config, Rule, Opts) -> asn1_test_lib:compile("SetDefault", Config, [Rule|Opts]), testSetDefault:main(Rule). -testParamBasic(Config) -> test(Config, fun testParamBasic/3). +testParamBasic(Config) -> + test(Config, fun testParamBasic/3, [ber,{ber,[der]},per,uper]). testParamBasic(Config, Rule, Opts) -> asn1_test_lib:compile("ParamBasic", Config, [Rule|Opts]), testParamBasic:main(Rule). @@ -873,11 +881,7 @@ testDER(Config) -> test(Config, fun testDER/3, [ber]). testDER(Config, Rule, Opts) -> asn1_test_lib:compile("DERSpec", Config, [Rule, der|Opts]), - testDER:test(), - asn1_test_lib:compile("ParamBasic", Config, [Rule, der|Opts]), - testParamBasic:main(der), - asn1_test_lib:compile("Default", Config, [Rule, der|Opts]), - testSeqSetDefaultVal:main(Rule). + testDER:test(). specialized_decodes(Config) -> test(Config, fun specialized_decodes/3, [ber]). diff --git a/lib/asn1/test/asn1_SUITE_data/Default.asn b/lib/asn1/test/asn1_SUITE_data/Default.asn index 6604953c1f..168ce50bb2 100644 --- a/lib/asn1/test/asn1_SUITE_data/Default.asn +++ b/lib/asn1/test/asn1_SUITE_data/Default.asn @@ -21,7 +21,8 @@ SeqBS ::= SEQUENCE { a BIT STRING DEFAULT '1010110'B, b BIT STRING DEFAULT 'A8A'H, c BIT STRING {first(0),second(1),third(2)} DEFAULT {second}, - d BIT STRING DEFAULT onelist + d BIT STRING DEFAULT onelist, + e BIT STRING DEFAULT '01011010'B } SetBS ::= SET { diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index 08e7f94ab6..a5b4c8a53d 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -46,7 +46,13 @@ BS256 ::= BIT STRING (SIZE (256)) BS1024 ::= BIT STRING (SIZE (1024)) - + BsDef1 ::= SEQUENCE { + s BIT STRING DEFAULT '101111'B + } + + BsDef2 ::= SEQUENCE { + s BIT STRING DEFAULT 'DEADBEEF'H + } Os ::= OCTET STRING OsCon ::= [60] OCTET STRING diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index 3a55408e94..3db89ca174 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -38,7 +38,9 @@ main(Rules) -> <<48,3,128,1,11>> = roundtrip_enc('T11', #'T11'{number=11,string="hej"}), <<48,3,128,1,11>> = - roundtrip_enc('T12', #'T12'{number=11,string=[1,0,1,0]}); + roundtrip_enc('T12', + #'T12'{number=11,string=[1,0,1,0]}, + #'T12'{number=11,string = <<10:4>>}); _ -> ok end, ok. @@ -48,3 +50,6 @@ roundtrip(Type, Value) -> roundtrip_enc(Type, Value) -> asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value). + +roundtrip_enc(Type, Value, Expected) -> + asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value, Expected). diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index be5409aa92..2fe0780701 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,7 +19,7 @@ %% -module(testPrimStrings). --export([bit_string/1]). +-export([bit_string/2]). -export([octet_string/1]). -export([numeric_string/1]). -export([other_strings/1]). @@ -68,7 +68,7 @@ fragmented_lengths() -> K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1, K64+K16-1,K64+K16,K64+K16+1]. -bit_string(Rules) -> +bit_string(Rules, Opts) -> %%========================================================== %% Bs1 ::= BIT STRING @@ -90,9 +90,10 @@ bit_string(Rules) -> bs_roundtrip('Bs1', [0,1,0,0,1,0]), bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]), bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), - - case Rules of - ber -> + + + case {Rules,Opts} of + {ber,[]} -> bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>, [0,1,0,0,1,0,0,1,0,0,1,0]), bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>, @@ -100,7 +101,17 @@ bit_string(Rules) -> bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]); _ -> - ok + %% DER, PER, UPER + consistent_def_enc('BsDef1', + [2#111101, + [1,0,1,1,1,1], + {2,<<2#101111:6,0:2>>}, + <<2#101111:6>>]), + consistent_def_enc('BsDef2', + [[1,1,0,1, 1,1,1,0, 1,0,1,0, 1,1,0,1, + 1,0,1,1, 1,1,1,0, 1,1,1,0, 1,1,1,1], + {0,<<16#DEADBEEF:4/unit:8>>}, + <<16#DEADBEEF:4/unit:8>>]) end, @@ -217,6 +228,24 @@ bit_string(Rules) -> _ -> per_bs_strings() end. +consistent_def_enc(Type, Vs) -> + M = 'PrimStrings', + {ok,Enc} = M:encode(Type, {Type,asn1_DEFAULT}), + {ok,Val} = M:decode(Type, Enc), + + %% Ensure that the value has the correct format. + case {M:bit_string_format(),Val} of + {bitstring,{_,Bs}} when is_bitstring(Bs) -> ok; + {compact,{_,{Unused,Bin}}} when is_integer(Unused), + is_binary(Bin) -> ok; + {legacy,{_,Bs}} when is_list(Bs) -> ok + end, + + %% All values should be recognized and encoded as the + %% the default value (i.e. not encoded at all). + _ = [{ok,Enc} = M:encode(Type, {Type,V}) || V <- Vs], + ok. + %% The PER encoding rules requires that a BIT STRING with %% named positions should never have any trailing zeroes %% (except to reach the minimum number of bits as given by diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index fb61bf1647..044099199f 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -18,7 +18,7 @@ %% %% -module(testSeqSetDefaultVal). --export([main/1]). +-export([main/2]). -include("External.hrl"). -include_lib("test_server/include/test_server.hrl"). @@ -34,7 +34,8 @@ -record('SeqBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, - d = asn1_DEFAULT}). + d = asn1_DEFAULT, + e = asn1_DEFAULT}). -record('SetBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, @@ -93,7 +94,119 @@ -record('S4_b',{ba = asn1_DEFAULT, bb = asn1_DEFAULT}). -main(_Rules) -> +main(ber, []) -> + %% Nothing to test because plain BER will only use + %% default values when explicitly told to do so by + %% asn1_DEFAULT. + ok; +main(Rule, Opts) -> + %% DER, PER, UPER. These encodings should not encode + %% values that are equal to the default value. + + case {Rule,Opts} of + {ber,[der]} -> + der(); + {_,_} -> + ok + end, + + Ts = [{#'SeqInts'{}, + [{#'SeqInts'.c, + [asn1_DEFAULT, + three, + 3]}]}, + + {#'SeqBS'{}, + [{#'SeqBS'.a, + [asn1_DEFAULT, + 2#0110101, + [1,0,1,0,1,1,0], + {1,<<16#AC>>}, + <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>]}, + {#'SeqBS'.b, + [asn1_DEFAULT, + 2#10100010101, + [1,0,1,0,1,0,0,0,1,0,1,0], + {4,<<16#A8,16#A0>>}, + <<16#A8:8,16#A:4>>]}, + {#'SeqBS'.c, + [asn1_DEFAULT, + [second], + [0,1], + {6,<<0:1,1:1,0:6>>}, + <<1:2>>]}, + {#'SeqBS'.c, %Zeroes on the right + [asn1_DEFAULT, + [second], + [0,1,0,0,0], + {4,<<0:1,1:1,0:6>>}, + <<1:2,0:17>>]}, + {#'SeqBS'.d, + [asn1_DEFAULT, + 2#1001, + [1,0,0,1], + {4,<<2#1001:4,0:4>>}, + <<2#1001:4>>]}, + {#'SeqBS'.e, + [asn1_DEFAULT, + [0,1,0,1,1,0,1,0], + {0,<<2#01011010:8>>}, + <<2#01011010:8>>]}, + %% Not EQUAL to DEFAULT. + {#'SeqBS'.b, + [[1,1,0], %Not equal to DEFAULT + {5,<<6:3,0:5>>}, + <<6:3>>]} + ]}, + + {#'SeqOS'{}, + [{#'SeqOS'.a, + [asn1_DEFAULT, + [172]]}]}, + + {#'SeqOI'{}, + [{#'SeqOI'.a, + [asn1_DEFAULT, + {1,2,14,15}]}, + {#'SeqOI'.b, + [asn1_DEFAULT, +%% {iso,'member-body',250,3,4}, + {1,2,250,3,4}]}, + {#'SeqOI'.c, + [asn1_DEFAULT, +%% {iso,standard,8571,2,250,4}, + {1,0,8571,2,250,4}]}]} + ], + io:format("~p\n", [Ts]), + R0 = [[consistency(Rec, Pos, Vs) || {Pos,Vs} <- Fs] || {Rec,Fs} <- Ts], + case lists:flatten(R0) of + [] -> + ok; + [_|_]=R -> + io:format("~p\n", [R]), + ?t:fail() + end. + +consistency(Rec0, Pos, [V|Vs]) -> + T = element(1, Rec0), + Rec = setelement(Pos, Rec0, V), + {ok,Enc} = 'Default':encode(T, Rec), + {ok,_SmokeTest} = 'Default':decode(T, Enc), + consistency_1(Vs, Rec0, Pos, Enc). + +consistency_1([V|Vs], Rec0, Pos, Enc) -> + Rec = setelement(Pos, Rec0, V), + case 'Default':encode(element(1, Rec), Rec) of + {ok,Enc} -> + consistency_1(Vs, Rec0, Pos, Enc); + {ok,WrongEnc} -> + [{Rec,{wrong,WrongEnc},{should_be,Enc}}| + consistency_1(Vs, Rec0, Pos, Enc)] + end; +consistency_1([], _, _, _) -> []. + +der() -> + io:put_chars("Peforming DER-specific tests..."), roundtrip(<<48,0>>, 'SeqInts', #'SeqInts'{a=asn1_DEFAULT,b=asn1_DEFAULT, @@ -117,50 +230,88 @@ main(_Rules) -> roundtrip(<<48,0>>, 'SeqBS', - #'SeqBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]}, - #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SeqBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), roundtrip(<<48,0>>, 'SeqBS', #'SeqBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=2#1001}, - #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), roundtrip(<<48,3,131,1,0>>, 'SeqBS', #'SeqBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=0}, - #'SeqBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d = <<>>}), + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + roundtrip(<<48,3,131,1,0>>, + 'SeqBS', + #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0, + e = <<16#5A:8>>}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + + %% None of the default values are used. + roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>, + 'SeqBS', + #'SeqBS'{a = <<1:1>>, + b = {5,<<64>>}, + c = [third], + d = 0, + e = <<7:3>>}, + #'SeqBS'{a = <<1:1>>, + b = <<2:3>>, + c = [third], + d = <<>>, + e = <<7:3>>}), roundtrip(<<49,0>>, 'SetBS', - #'SetBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]}, - #'SetBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SetBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), roundtrip(<<49,0>>, 'SetBS', #'SetBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=9}, - #'SetBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d=[1,0,0,1]}), + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), roundtrip(<<49,3,131,1,0>>, 'SetBS', #'SetBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=0}, - #'SetBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d = <<>>}), + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), + roundtrip(<<49,3,131,1,0>>, + 'SetBS', + #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), roundtrip(<<48,0>>, 'SeqOS', #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), -- cgit v1.2.3 From f2a7538022e6d094bfbb003718fec688d3ba189e Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 1 Oct 2013 15:33:28 +0200 Subject: erts: Fix time_SUITE:consistency to work over turn of the month --- erts/emulator/test/time_SUITE.erl | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl index 4d12e3449c..a0a8a9c42c 100644 --- a/erts/emulator/test/time_SUITE.erl +++ b/erts/emulator/test/time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -241,14 +241,26 @@ compare(Utc0, Local) -> %% Two linear times can be subtracted to give their difference %% in seconds. %% -%% XXX Limitations: The length of months and leap years are not -%% taken into account; thus a comparision of dates is only -%% valid if they are in the SAME month. +%% XXX Limitations: Simplified leap year calc will fail for 2100 :-) linear_time({{Year, Mon, Day}, {Hour, Min, Sec}}) -> - 86400*(366*Year + 31*(Mon-1) + (Day-1)) + + 86400*(year_to_days(Year) + month_to_days(Year,Mon) + (Day-1)) + 3600*Hour + 60*Min + Sec. +year_to_days(Year) -> + Year * 365 + (Year-1) div 4. + +month_to_days(Year, Mon) -> + DoM = [31,days_in_february(Year),31,30,31,30,31,31,30,31,30,31], + {PastMonths,_} = lists:split(Mon-1, DoM), + lists:sum(PastMonths). + +days_in_february(Year) -> + case (Year rem 4) of + 0 -> 29; + _ -> 28 + end. + %% This functions returns either the normal timezone or the %% the DST timezone, depending on the given UTC time. %% -- cgit v1.2.3 From ee39709b4ae375277c6380033c9c9f04b0242b43 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 26 Sep 2013 22:37:43 +0200 Subject: erts: Fix misc minor bugs in supercarrier initialization --- erts/emulator/sys/common/erl_mmap.c | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 60b32e8115..52041fd03e 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -1394,15 +1394,17 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end) */ #if ERTS_HAVE_OS_MMAP - ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0); - if (ptr) { - mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; - ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE); - add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE); - desc = alloc_desc(); - ERTS_MMAP_ASSERT(desc); - insert_free_seg(map, desc, start, end); - return 0; + if (!mmap_state.no_os_mmap) { + ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0); + if (ptr) { + mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; + ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE); + add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE); + desc = alloc_desc(); + ERTS_MMAP_ASSERT(desc); + insert_free_seg(map, desc, start, end); + return 0; + } } #endif @@ -2166,6 +2168,7 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.sa.bot = NULL; mmap_state.sua.top = NULL; mmap_state.no_os_mmap = 0; + mmap_state.supercarrier = 0; } else { size_t desc_size; @@ -2185,10 +2188,10 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.sa.bot += desc_size; mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot); mmap_state.sa.top = mmap_state.sa.bot; - mmap_state.sua.top = (char *) ERTS_SUPERALIGNED_FLOOR(end); + mmap_state.sua.top = end; mmap_state.sua.bot = mmap_state.sua.top; - mmap_state.size.os.used += (UWord) (mmap_state.sa.bot - start); + mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start); mmap_state.desc.free_list = NULL; mmap_state.desc.reserved = 0; @@ -2201,7 +2204,7 @@ erts_mmap_init(ErtsMMapInit *init) * into the super carrier... */ mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE; - mmap_state.size.os.used += ERTS_PAGEALIGNED_SIZE; + mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE; #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE)) #endif @@ -2209,7 +2212,7 @@ erts_mmap_init(ErtsMMapInit *init) mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc); } - mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - mmap_state.sa.bot); + mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start); /* * Area before (and after) super carrier -- cgit v1.2.3 From e9f670e542dd2ea2dc29dff66d3516a3fd0d2d21 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 1 Oct 2013 17:11:27 +0200 Subject: erts: Fix lock violation for init_atoms in erl_mmap.c by not holding the mseg lock while reading version and option info which is unnecessary anyway. --- erts/emulator/sys/common/erl_mseg.c | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index b165f76c96..94a381e168 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -962,8 +962,6 @@ init_atoms(ErtsMsegAllctr_t *ma) #ifdef DEBUG Eterm *atom; #endif - - ERTS_MSEG_UNLOCK(ma); erts_mtx_lock(&init_atoms_mutex); if (!atoms_initialized) { @@ -1007,7 +1005,6 @@ init_atoms(ErtsMsegAllctr_t *ma) #endif } - ERTS_MSEG_LOCK(ma); atoms_initialized = 1; erts_mtx_unlock(&init_atoms_mutex); } @@ -1293,14 +1290,8 @@ erts_mseg_info_options(int ix, ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(ix); Eterm res; - ERTS_MSEG_LOCK(ma); - - ERTS_DBG_MA_CHK_THR_ACCESS(ma); - res = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp); - ERTS_MSEG_UNLOCK(ma); - return res; } @@ -1318,10 +1309,6 @@ erts_mseg_info(int ix, Eterm values[4]; Uint n = 0; - ERTS_MSEG_LOCK(ma); - - ERTS_DBG_MA_CHK_THR_ACCESS(ma); - if (hpp || szp) { if (!atoms_initialized) @@ -1334,6 +1321,10 @@ erts_mseg_info(int ix, } values[n++] = info_version(ma, print_to_p, print_to_arg, hpp, szp); values[n++] = info_options(ma, "option ", print_to_p, print_to_arg, hpp, szp); + + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + #if HALFWORD_HEAP values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp); -- cgit v1.2.3 From ff95e85937007a7952477c7acc7619791405ab1c Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 1 Oct 2013 18:12:43 +0200 Subject: erts: Add mutex to init_atoms in erts_mmap.c --- erts/emulator/beam/erl_lock_check.c | 1 + erts/emulator/sys/common/erl_mmap.c | 109 +++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 50 deletions(-) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 87efbdbc3e..0dd83fa6ed 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -132,6 +132,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { #endif /* __WIN32__ */ { "alcu_init_atoms", NULL }, { "mseg_init_atoms", NULL }, + { "mmap_init_atoms", NULL }, { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, #ifdef ERTS_SMP diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 52041fd03e..a9da7430fb 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -2039,6 +2039,64 @@ int erts_mmap_in_supercarrier(void *ptr) return ERTS_MMAP_IN_SUPERCARRIER(ptr); } + +static struct { + Eterm total; + Eterm total_sa; + Eterm total_sua; + Eterm used; + Eterm used_sa; + Eterm used_sua; + Eterm max; + Eterm allocated; + Eterm reserved; + Eterm sizes; + Eterm free_segs; + Eterm supercarrier; + Eterm os; + Eterm scs; + Eterm sco; + Eterm scrpm; + Eterm scmgc; + + int is_initialized; + erts_mtx_t init_mutex; +}am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void init_atoms(void) +{ + erts_mtx_lock(&am.init_mutex); + + if (!am.is_initialized) { + AM_INIT(total); + AM_INIT(total_sa); + AM_INIT(total_sua); + AM_INIT(used); + AM_INIT(used_sa); + AM_INIT(used_sua); + AM_INIT(max); + AM_INIT(allocated); + AM_INIT(reserved); + AM_INIT(sizes); + AM_INIT(free_segs); + AM_INIT(supercarrier); + AM_INIT(os); + AM_INIT(scs); + AM_INIT(sco); + AM_INIT(scrpm); + AM_INIT(scmgc); + am.is_initialized = 1; + } + erts_mtx_unlock(&am.init_mutex); +}; + + #ifdef HARD_DEBUG_MSEG static void hard_dbg_mseg_init(void); #endif @@ -2085,6 +2143,7 @@ erts_mmap_init(ErtsMMapInit *init) #endif erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap"); + erts_mtx_init(&am.init_mutex, "mmap_init_atoms"); #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION if (init->virtual_range.start) { @@ -2246,56 +2305,6 @@ erts_mmap_init(ErtsMMapInit *init) #endif } -static struct { - Eterm total; - Eterm total_sa; - Eterm total_sua; - Eterm used; - Eterm used_sa; - Eterm used_sua; - Eterm max; - Eterm allocated; - Eterm reserved; - Eterm sizes; - Eterm free_segs; - Eterm supercarrier; - Eterm os; - Eterm scs; - Eterm sco; - Eterm scrpm; - Eterm scmgc; - - int is_initialized; -}am; - -static void ERTS_INLINE atom_init(Eterm *atom, char *name) -{ - *atom = am_atom_put(name, strlen(name)); -} -#define AM_INIT(AM) atom_init(&am.AM, #AM) - -static void init_atoms(void) -{ - AM_INIT(total); - AM_INIT(total_sa); - AM_INIT(total_sua); - AM_INIT(used); - AM_INIT(used_sa); - AM_INIT(used_sua); - AM_INIT(max); - AM_INIT(allocated); - AM_INIT(reserved); - AM_INIT(sizes); - AM_INIT(free_segs); - AM_INIT(supercarrier); - AM_INIT(os); - AM_INIT(scs); - AM_INIT(sco); - AM_INIT(scrpm); - AM_INIT(scmgc); - am.is_initialized = 1; -}; - static ERTS_INLINE void add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) -- cgit v1.2.3 From 5db2c05af6efaf636b2e41e3a1f305c592a71f34 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 3 Oct 2013 15:46:59 +0200 Subject: erts: Add test case for erts_mmap --- erts/emulator/test/alloc_SUITE.erl | 69 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 66 insertions(+), 3 deletions(-) diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 801ed0f85a..f6ff6bb813 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -29,6 +29,7 @@ bucket_mask/1, rbtree/1, mseg_clear_cache/1, + erts_mmap/1, cpool/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -41,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, - bucket_mask, rbtree, mseg_clear_cache, cpool]. + bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool]. groups() -> []. @@ -110,6 +111,59 @@ cpool(suite) -> []; cpool(doc) -> []; cpool(Cfg) -> ?line drv_case(Cfg). +erts_mmap(Config) when is_list(Config) -> + case {?t:os_type(), is_halfword_vm()} of + {{unix, _}, false} -> + [erts_mmap_do(Config, SCO, SCRPM, SCMGC) + || SCO <-[true,false], SCMGC <-[1234,0], SCRPM <- [true,false]]; + + {_,true} -> + {skipped, "No supercarrier support on halfword vm"}; + {SkipOs,_} -> + ?line {skipped, + lists:flatten(["Not run on " + | io_lib:format("~p",[SkipOs])])} + end. + + +erts_mmap_do(Config, SCO, SCRPM, SCMGC) -> + SCS = 100, % Mb + O1 = "+MMscs" ++ integer_to_list(SCS) + ++ " +MMsco" ++ atom_to_list(SCO) + ++ " +MMscrpm" ++ atom_to_list(SCRPM), + Opts = case SCMGC of + 0 -> O1; + _ -> O1 ++ " +MMscmgc"++integer_to_list(SCMGC) + end, + {ok, Node} = start_node(Config, Opts), + Self = self(), + Ref = make_ref(), + F = fun () -> + SI = erlang:system_info({allocator,mseg_alloc}), + {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), + {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), + {sizes,Sizes} = lists:keyfind(sizes, 1, SC), + {free_segs,Segs} = lists:keyfind(free_segs,1,SC), + {total,Total} = lists:keyfind(total,1,Sizes), + Total = SCS*1024*1024, + + {reserved,Reserved} = lists:keyfind(reserved,1,Segs), + true = (Reserved >= SCMGC), + + case {SCO,lists:keyfind(os,1,EM)} of + {true, false} -> ok; + {false, {os,_}} -> ok + end, + + Self ! {Ref, ok} + end, + + spawn_link(Node, F), + Result = receive {Ref, Rslt} -> Rslt end, + stop_node(Node), + Result. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Internal functions %% @@ -179,7 +233,9 @@ receive_drv_result(Port, CaseName) -> ?line {comment, Comment} end. -start_node(Config) when is_list(Config) -> +start_node(Config) -> + start_node(Config, []). +start_node(Config, Opts) when is_list(Config), is_list(Opts) -> ?line Pa = filename:dirname(code:which(?MODULE)), ?line {A, B, C} = now(), ?line Name = list_to_atom(atom_to_list(?MODULE) @@ -191,7 +247,14 @@ start_node(Config) when is_list(Config) -> ++ integer_to_list(B) ++ "-" ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). stop_node(Node) -> ?t:stop_node(Node). + +is_halfword_vm() -> + case {erlang:system_info({wordsize, internal}), + erlang:system_info({wordsize, external})} of + {4, 8} -> true; + {WS, WS} -> false + end. -- cgit v1.2.3 From a64ee8724ba7c5d9b0e0560591765cbfd6fabe97 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:03:38 +0200 Subject: Add some more comments about what the test does This changed the lines so the results now differ. --- lib/dialyzer/test/small_SUITE_data/results/trec | 12 ++++++------ lib/dialyzer/test/small_SUITE_data/src/trec.erl | 16 +++++++++------- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/results/trec b/lib/dialyzer/test/small_SUITE_data/results/trec index 01ccc63761..b95df1e6ef 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/trec +++ b/lib/dialyzer/test/small_SUITE_data/results/trec @@ -1,7 +1,7 @@ -trec.erl:26: Function test/0 has no local return -trec.erl:27: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) -trec.erl:29: Function mk_foo_loc/2 has no local return -trec.erl:30: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() -trec.erl:36: Function mk_foo_exp/2 has no local return -trec.erl:37: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:28: Function test/0 has no local return +trec.erl:29: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) +trec.erl:31: Function mk_foo_loc/2 has no local return +trec.erl:32: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:38: Function mk_foo_exp/2 has no local return +trec.erl:39: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl index ba50c3b401..06706162c1 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl @@ -18,20 +18,22 @@ %% ('undefined',atom()) %% 3. Function mk_foo_loc/2 has no local return %% -%% Arguably, the second warning is not what most users have in mind -%% when they wrote the type declarations in the 'foo' record, so no -%% doubt they'll find it confusing. But note that it is also inconsistent! -%% How come there is a success typing for a function that has no local return? +%% Arguably, the second warning is not what most users have in mind when +%% they wrote the type declarations in the 'foo' record, so no doubt +%% they'll find it confusing. But note that it is also quite confusing! +%% Many users may be wondering: How come there is a success typing for a +%% function that has no local return? Running typer on this module +%% reveals a success typing for this function that is interesting indeed. %% test() -> - mk_foo_loc(42, bar:f()). + mk_foo_loc(42, some_mod:some_function()). mk_foo_loc(A, B) -> #foo{a = A, b = [A,B]}. %% -%% For this function we currently get "has no local return" but we get -%% no reason; I want us to get a reason. +%% For this function we used to get a "has no local return" warning +%% but we got no reason. This has now been fixed. %% mk_foo_exp(A, B) when is_integer(A) -> #foo{a = A, b = [A,B]}. -- cgit v1.2.3 From fd6f74bff18a48132eef49be363726ae7ef823a6 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:04:58 +0200 Subject: Fix a comment --- lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl index 60ffbe818f..ddb97796fb 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl @@ -1,6 +1,6 @@ %%--------------------------------------------------------------------- %% This is added as a test because it was giving a false positive -%% (function move/4 will nevr be called) due to the strange use of +%% (function move/4 will never be called) due to the strange use of %% self-recursive fun construction in placex/3. %% %% The analysis was getting confused that the foldl call will never -- cgit v1.2.3 From ef0d395e38e9a009e2f9366acb77df999d69e832 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:06:12 +0200 Subject: Adopt a convention about unknown modules --- lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl index b58fa732cb..3acc5ca065 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl @@ -1,6 +1,6 @@ %% -%% The Original Code is RabbitMQ. -%% +%% This is stripped down code from RabbitMQ. It is used to report an +%% invalid type specification for function list_vhost_permissions/1. %% The Initial Developer of the Original Code is VMware, Inc. %% @@ -38,7 +38,7 @@ vhost_perms_info_keys() -> -spec list_vhost_permissions(vhost()) -> infos(). list_vhost_permissions(VHostPath) -> - list_permissions(vhost_perms_info_keys(), rabbit_foo:some_list()). + list_permissions(vhost_perms_info_keys(), some_mod:some_function()). filter_props(Keys, Props) -> [T || T = {K, _} <- Props, lists:member(K, Keys)]. -- cgit v1.2.3 From 1e665762b7e3f5d6e8da2137130e842432f246b2 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:06:53 +0200 Subject: Use the modern version of is_subtype --- lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl index 0af4f7446f..074a93e2fe 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl @@ -1,5 +1,5 @@ %%----------------------------------------------------------------------------- -%% Test that tests overloaded contratcs. +%% Test that tests overloaded contracts. %% In December 2008 it works as far as intersection types are concerned (test1) %% However, it does NOT work as far as type variables are concerned (test2) %%----------------------------------------------------------------------------- @@ -16,13 +16,13 @@ test2() -> -type mod() :: atom(). --spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when is_subtype(ATM, mod()) - ; (MFA, list()) -> {'ok', MFA} | {'error', _} when is_subtype(MFA, mfa()). +-spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when ATM :: mod() + ; (MFA, list()) -> {'ok', MFA} | {'error', _} when MFA :: mfa(). foo(F, _) when is_atom(F) -> case atom_to_list(F) of - [42|_] -> {ok, F}; - _Other -> {error, mod:bar(F)} + [42|_] -> {ok, F}; + _Other -> {error, some_mod:some_function()} end; foo({M,F,A}, _) -> case A =:= 0 of -- cgit v1.2.3 From d25ed2cf7161c22544a667464fe4d3f3f156a9db Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:07:40 +0200 Subject: No reason for calls to unknown modules --- lib/dialyzer/test/small_SUITE_data/src/contract3.erl | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl index 5b0bee9694..a6ce91882e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl @@ -18,16 +18,23 @@ t(X, Y, Z) -> (atom()|list()) -> atom(). t1(X) -> - foo:bar(X). + f(X). -spec t2(atom(), integer()) -> integer(); (atom(), list()) -> atom(). t2(X, Y) -> - foo:bar(X, Y). + g(X, Y). -spec t3(atom(), integer(), list()) -> integer(); (X, integer(), list()) -> X. t3(X, Y, Z) -> X. + +%% dummy functions below + +f(X) -> X. + +g(X, Y) when is_atom(X), is_integer(Y) -> Y; +g(X, Y) when is_atom(X), is_list(Y) -> X. -- cgit v1.2.3 From 3a481b4a687803b69ede848a75299b4b277f4296 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:08:05 +0200 Subject: Adopt a convention about unknown modules --- lib/dialyzer/test/small_SUITE_data/src/gencall.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl index d2875c9df1..762be55007 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl @@ -7,6 +7,6 @@ f() -> gen_server:call(1,2,3), ets:lookup(1,2,3), - gencall2:foo(), + some_mod:some_function(), gencall:foo(), gen_server:handle_cast(1,2). -- cgit v1.2.3 From e978ff2a2c634ef2a4af7372cf2ecce8d70743b9 Mon Sep 17 00:00:00 2001 From: Kostis Sagonas Date: Wed, 9 Oct 2013 17:09:17 +0200 Subject: Fix crash when using remote types in the tail of list types Hans Bolider reported a dialyzer crash when using a remote type in the tail position of a maybe_improper_list() declaration. A test was created (by extending an existing module of the testsuite) and erl_types was modified to expand the remote type and not pass it unexpanded to subsequent phases in the processing. --- .../test/small_SUITE_data/src/maybe_improper.erl | 17 ++++++++++++++--- lib/hipe/cerl/erl_types.erl | 13 +++++++------ 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl index 1743d81493..6d2a35b7c8 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl @@ -1,7 +1,18 @@ +%%%======================================================================== +%%% Tests handling of maybe improper lists +%%%======================================================================== -module(maybe_improper). --export([s/1]). +-export([s/1, t/0]). -spec s(maybe_improper_list(X,Y)) -> {[X], maybe_improper_list(X,Y)}. -s(A) -> - lists:split(2,A). +s(L) -> + lists:split(2, L). + +%% Having a remote type in the 'tail' of the list crashed dialyzer. +%% The problem was fixed for R16B03. +-type t_mil() :: maybe_improper_list(integer(), orddict:orddict()). + +-spec t() -> t_mil(). +t() -> + [42 | []]. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d1243b2325..d7d8a878c5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -671,8 +671,9 @@ t_solve_remote(?function(Domain, Range), ET, R, C) -> {RT2, RR2} = t_solve_remote(Range, ET, R, C), {?function(RT1, RT2), RR1 ++ RR2}; t_solve_remote(?list(Types, Term, Size), ET, R, C) -> - {RT, RR} = t_solve_remote(Types, ET, R, C), - {?list(RT, Term, Size), RR}; + {RT1, RR1} = t_solve_remote(Types, ET, R, C), + {RT2, RR2} = t_solve_remote(Term, ET, R, C), + {?list(RT1, RT2, Size), RR1 ++ RR2}; t_solve_remote(?product(Types), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {?product(RL), RR}; @@ -1349,8 +1350,8 @@ t_maybe_improper_list() -> t_maybe_improper_list(_Content, ?unit) -> ?none; t_maybe_improper_list(?unit, _Termination) -> ?none; t_maybe_improper_list(Content, Termination) -> - %% Safety check - true = t_is_subtype(t_nil(), Termination), + %% Safety check: would be nice to have but does not work with remote types + %% true = t_is_subtype(t_nil(), Termination), ?list(Content, Termination, ?unknown_qual). -spec t_is_maybe_improper_list(erl_type()) -> boolean(). @@ -1365,8 +1366,8 @@ t_is_maybe_improper_list(_) -> false. %% t_improper_list(?unit, _Termination) -> ?none; %% t_improper_list(_Content, ?unit) -> ?none; %% t_improper_list(Content, Termination) -> -%% %% Safety check -%% false = t_is_subtype(t_nil(), Termination), +%% %% Safety check: would be nice to have but does not work with remote types +%% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). -- cgit v1.2.3 From c552255525f51fcd06e847149b8ce83bb0a99626 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 10 Oct 2013 10:55:18 +0200 Subject: Documentation of tracer/2: Use the correct option name 'overload_check' The implementation and the documentation disagreed on the name of option. --- lib/observer/doc/src/ttb.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 4e63aecbf2..1453bbdf10 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -105,8 +105,9 @@ ttb:p(all, call) Nodes = atom() | [atom()] | all | existing | new Opts = Opt | [Opt] Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | - shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} - | {flush, MSec} | resume | {resume, FetchTimeout} + shell | {shell, ShellSpec} | {timer, TimerSpec} | + {overload_check, {MSec, Module, Function}} | + {flush, MSec} | resume | {resume, FetchTimeout} TimerSpec = MSec | {MSec, StopOpts} MSec = FetchTimeout = integer() Module = Function = atom() @@ -158,7 +159,7 @@ ttb:p(all, call) network communication are always present. The timer starts after ttb:p/2 is issued, so you can set up your trace patterns before.

-

The overload option allows to enable overload +

The overload_check option allows to enable overload checking on the nodes under trace. Module:Function(check) is performed each MSec milliseconds. If the check returns true, the tracing is disabled on a given node.
-- cgit v1.2.3 From 442d802ae4b8a75d69c37d0d5251d4198c642624 Mon Sep 17 00:00:00 2001 From: Ali Sabil Date: Wed, 19 Jun 2013 22:32:44 +0200 Subject: Fix the typespec for the inet:ifget/2 and inet:ifget/3 return value --- lib/kernel/src/inet.erl | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 27f085c3aa..d4c78505da 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -120,6 +120,17 @@ 'addr' | 'broadaddr' | 'dstaddr' | 'mtu' | 'netmask' | 'flags' |'hwaddr'. +-type if_getopt_result() :: + {'addr', ip_address()} | + {'broadaddr', ip_address()} | + {'dstaddr', ip_address()} | + {'mtu', non_neg_integer()} | + {'netmask', ip_address()} | + {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' | + 'pointtopoint' | 'no_pointtopoint' | + 'running' | 'multicast' | 'loopback']} | + {'hwaddr', ether_address()}. + -type address_family() :: 'inet' | 'inet6'. -type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. -type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. @@ -266,13 +277,13 @@ getiflist() -> -spec ifget(Socket :: socket(), Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Socket, Name, Opts) -> prim_inet:ifget(Socket, Name, Opts). -spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Name, Opts) -> withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end). -- cgit v1.2.3 From 06cb6b47b7bd9a890b0f06ecb2bf6f8102a095ac Mon Sep 17 00:00:00 2001 From: Artem Teslenko Date: Thu, 19 Sep 2013 15:28:38 +0300 Subject: Add more SCTP errors as described in RFC 4960 --- lib/kernel/src/gen_sctp.erl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 58d84ae924..067e07304d 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -423,7 +423,11 @@ error_string(9) -> error_string(10) -> "Cookie Received While Shutting Down"; error_string(11) -> + "Restart of an Association with New Addresses"; +error_string(12) -> "User Initiated Abort"; +error_string(13) -> + "Protocol Violation"; %% For more info on principal SCTP error codes: phone +44 7981131933 error_string(N) when is_integer(N) -> unknown_error; -- cgit v1.2.3 From 255d5450280c30b8e8f83d79281abd1fbadcfa02 Mon Sep 17 00:00:00 2001 From: Tomas Morstein Date: Sun, 29 Sep 2013 20:13:12 +0200 Subject: fix a little typo in public_key documentation In the example of `public_key:pem_entry_encode/2`, the result should match to `PemEntry` rather than to `PemBin` since `PemEntry` is expected as an input argument of `public_key:pem_encode/1` called just on the next line of the example. --- lib/public_key/doc/src/using_public_key.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index 5d9f1536d9..b744704c47 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -350,7 +350,7 @@ ok

or

- 1> PemBin = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). + 1> PemEntry = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). {'SubjectPublicKeyInfo', <<48,92...>>, not_encrypted} 2> PemBin = public_key:pem_encode([PemEntry]). -- cgit v1.2.3 From 4364de3cc6c6212b291a5c240f25a00e90b2e852 Mon Sep 17 00:00:00 2001 From: Lars Hesel Christensen Date: Tue, 24 Sep 2013 11:09:42 +0200 Subject: Add bsr test data showing bug when shifting large numbers Add test data demonstrating that bsr is broken when shifting a large number a huge number of bits to the right. --- erts/emulator/test/big_SUITE_data/eq_big.dat | 1 + 1 file changed, 1 insertion(+) diff --git a/erts/emulator/test/big_SUITE_data/eq_big.dat b/erts/emulator/test/big_SUITE_data/eq_big.dat index 5511d1bf10..4ccb33d182 100644 --- a/erts/emulator/test/big_SUITE_data/eq_big.dat +++ b/erts/emulator/test/big_SUITE_data/eq_big.dat @@ -13001,4 +13001,5 @@ 0 = 7153697524993 bsr 475833444444444444444444444444444444444444444444. -1 = -83987348 bsr 475833444444444444444444444444444444444444444444. +0 = 1183140560213014108063589658350 bsr 146783911423364576743092537299333564210980159306769991919205685720763064069663027716481187399048043939495935. -- cgit v1.2.3 From 54aecc2a73a1398d141c7f8e9a96c24a5a5731cf Mon Sep 17 00:00:00 2001 From: Lars Hesel Christensen Date: Tue, 24 Sep 2013 11:22:48 +0200 Subject: Fix bsr bug Fix bsr bug occurring when shifting a huge number a huge number of bits to the right. The bug can occur if Sint is 64 bits and int is 32 bits, causing a truncation in the big.c:I_lshift function. --- erts/emulator/beam/big.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 6b43c53985..2b27b111d8 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1325,9 +1325,9 @@ static dsize_t I_lshift(ErtsDigit* x, dsize_t xl, Sint y, return 1; } else { - SWord ay = (y < 0) ? -y : y; - int bw = ay / D_EXP; - int sw = ay % D_EXP; + Uint ay = (y < 0) ? -y : y; + Uint bw = ay / D_EXP; + Uint sw = ay % D_EXP; dsize_t rl; ErtsDigit a1=0; ErtsDigit a0=0; @@ -1368,7 +1368,7 @@ static dsize_t I_lshift(ErtsDigit* x, dsize_t xl, Sint y, } if (sign) { - int zl = bw; + Uint zl = bw; ErtsDigit* z = x; while(zl--) { -- cgit v1.2.3 From e73a6daccfcf9f4f51fcc0b024756dbe9b61c4ba Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Thu, 10 Oct 2013 15:21:01 +0200 Subject: public_key: change encoding to utf8 --- lib/public_key/doc/src/using_public_key.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index b744704c47..450bd7e35f 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -1,4 +1,4 @@ - + @@ -90,7 +90,7 @@ [{'RSAPrivateKey',<<224,108,117,203,152,40,15,77,128,126, 221,195,154,249,85,208,202,251,109, 119,120,57,29,89,19,9,...>>, - {"DES-EDE3-CBC",<<"kÙeø¼pµL">>}}] + {"DES-EDE3-CBC",<<"kÙeø¼pµL">>}}] -- cgit v1.2.3 From 9464f00442433ec6165ff9b69858b86a8f7db832 Mon Sep 17 00:00:00 2001 From: Paul Oliver Date: Thu, 10 Oct 2013 20:25:30 +0200 Subject: Add iodata, nonempty_string to built-in type highlighting for emacs These built-in types were missing from emacs highlighting --- lib/tools/emacs/erlang.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 624042204c..d459239c38 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -697,6 +697,7 @@ resulting regexp is surrounded by \\_< and \\_>." "char" "cons" "deep_string" + "iodata" "iolist" "maybe_improper_list" "module" @@ -708,6 +709,7 @@ resulting regexp is surrounded by \\_< and \\_>." "nonempty_list" "nonempty_improper_list" "nonempty_maybe_improper_list" + "nonempty_string" "no_return" "pos_integer" "string" -- cgit v1.2.3 From 513f4130b13bcb7360c5a70e940abe1320490e68 Mon Sep 17 00:00:00 2001 From: Peter Andersson Date: Wed, 9 Oct 2013 17:38:15 +0200 Subject: Use normal- instead of scaled timeouts in test case --- lib/common_test/test/ct_pre_post_test_io_SUITE.erl | 43 ++++++++++++---------- .../ct_pre_post_test_io_SUITE_data/cth_ctrl.erl | 3 +- 2 files changed, 25 insertions(+), 21 deletions(-) diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 84341a0b99..5de1ecc2bd 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -89,28 +89,31 @@ pre_post_io(Config) -> %%!-------------------------------------------------------------------- spawn(fun() -> + ct:pal("CONTROLLER: Started!", []), %% --- test run 1 --- - ct:sleep(3000), - ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - io:format(user, "Starting test run!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - ct:sleep(6000), - io:format(user, "Finishing off!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), %% --- test run 2 --- - ct:sleep(3000), - ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - io:format(user, "Starting test run!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - ct:sleep(6000), - io:format(user, "Finishing off!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) end), ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl index c8c08a5735..2ba991fc61 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -28,7 +28,8 @@ %%%=================================================================== proceed() -> - ?MODULE ! proceed. + ?MODULE ! proceed, + ok. %%-------------------------------------------------------------------- %% Hook functions -- cgit v1.2.3 From 8dfd57ab8581813bee1404e5fe2d74081d9c1c0a Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Fri, 11 Oct 2013 15:18:30 +0200 Subject: common_test: added code_change/3 for gen_event behaviour --- lib/common_test/src/cth_log_redirect.erl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index b7f0e1fd7f..f5e769e1ba 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -34,13 +34,15 @@ %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2]). + terminate/2, code_change/3]). %% Other -export([handle_remote_events/1]). -include("ct.hrl"). +-behaviour(gen_event). + -record(eh_state, {log_func, curr_suite, curr_group, @@ -236,3 +238,6 @@ format_header(#eh_state{curr_suite = Suite, curr_func = TC}) -> io_lib:format("System report during ~w:~w/1 in ~w", [Suite,TC,Group]). + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. -- cgit v1.2.3 From dec57df06c6ed0f96995b979d16489c484039bd2 Mon Sep 17 00:00:00 2001 From: "Brian L. Troutwine" Date: Sat, 12 Oct 2013 16:02:20 -0700 Subject: Change 'recive' to 'receive' in gen_server.erl A small spelling correction merely; no functionality change. --- lib/stdlib/src/gen_server.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 7f65131f67..df68a37c06 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -393,7 +393,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> end. %%% --------------------------------------------------- -%%% Send/recive functions +%%% Send/receive functions %%% --------------------------------------------------- do_send(Dest, Msg) -> case catch erlang:send(Dest, Msg, [noconnect]) of -- cgit v1.2.3 From 475a34dc371503e601989125b9e4124cfcb26a5f Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Mon, 7 Oct 2013 15:06:51 +0200 Subject: ssl: Honor TLS client ECC extension Also the server should only send ECC point formats extension not ECC curve extension. --- lib/ssl/src/ssl_cipher.erl | 2 +- lib/ssl/src/ssl_handshake.erl | 74 +++++++++++++++++++++++++++--------------- lib/ssl/src/ssl_handshake.hrl | 3 +- lib/ssl/src/tls_connection.erl | 31 +++++++----------- lib/ssl/src/tls_handshake.erl | 7 ++-- 5 files changed, 66 insertions(+), 51 deletions(-) diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 6513042e98..e6ed0d8626 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,7 @@ -export([security_parameters/2, security_parameters/3, suite_definition/1, decipher/5, cipher/5, - suite/1, suites/1, anonymous_suites/0, psk_suites/1, srp_suites/0, + suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 29a8996bd6..b18452a8f2 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -49,13 +49,13 @@ ]). %% Cipher suites handling --export([available_suites/2, available_suites/3, cipher_suites/2, - select_session/10]). +-export([available_suites/2, cipher_suites/2, + select_session/10, supported_ecc/1]). %% Extensions handling -export([client_hello_extensions/5, handle_client_hello_extensions/8, %% Returns server hello extensions - handle_server_hello_extensions/9 + handle_server_hello_extensions/9, select_curve/2 ]). %% MISC @@ -89,7 +89,7 @@ client_hello_extensions(Version, CipherSuites, SslOpts, ConnectionStates, Renego {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of true -> - ecc_extensions(tls_v1, Version); + client_ecc_extensions(tls_v1, Version); false -> {undefined, undefined} end, @@ -861,22 +861,29 @@ available_suites(UserSuites, Version) -> UserSuites end. -available_suites(ServerCert, UserSuites, Version) -> - ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)). +available_suites(ServerCert, UserSuites, Version, Curve) -> + ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) + -- unavailable_ecc_suites(Curve). + +unavailable_ecc_suites(no_curve) -> + ssl_cipher:ec_keyed_suites(); +unavailable_ecc_suites(_) -> + []. cipher_suites(Suites, false) -> [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; cipher_suites(Suites, true) -> Suites. -select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Version, +select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} = + Session, Version, #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) -> {SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId, SslOpts, Cert, Cache, CacheCb), - Suites = ssl_handshake:available_suites(Cert, UserSuites, Version), case Resumed of undefined -> + Suites = available_suites(Cert, UserSuites, Version, ECCCurve), CipherSuite = select_cipher_suite(CipherSuites, Suites), Compression = select_compression(Compressions), {new, Session#session{session_id = SessionId, @@ -886,6 +893,13 @@ select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Ve {resumed, Resumed} end. +supported_ecc(Version) -> + case tls_v1:ecc_curves(Version) of + [] -> + undefined; + Curves -> + #elliptic_curves{elliptic_curve_list = Curves} + end. %%-------------certificate handling -------------------------------- certificate_types({KeyExchange, _, _, _}) @@ -926,9 +940,8 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) -> handle_client_hello_extensions(RecordCB, Random, #hello_extensions{renegotiation_info = Info, srp = SRP, - next_protocol_negotiation = NextProtocolNegotiation, - ec_point_formats = EcPointFormats0, - elliptic_curves = EllipticCurves0}, Version, + ec_point_formats = ECCFormat, + next_protocol_negotiation = NextProtocolNegotiation}, Version, #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, #session{cipher_suite = CipherSuite, compression_method = Compression} = Session0, ConnectionStates0, Renegotiation) -> @@ -937,12 +950,11 @@ handle_client_hello_extensions(RecordCB, Random, Random, CipherSuite, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), - {EcPointFormats, EllipticCurves} = handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0), + ServerHelloExtensions = #hello_extensions{ renegotiation_info = renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, + ec_point_formats = server_ecc_extension(Version, ECCFormat), next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsToAdvertise) }, @@ -1078,7 +1090,7 @@ srp_user(#ssl_options{srp_identity = {UserName, _}}) -> srp_user(_) -> undefined. -ecc_extensions(Module, Version) -> +client_ecc_extensions(Module, Version) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> @@ -1089,15 +1101,13 @@ ecc_extensions(Module, Version) -> {undefined, undefined} end. -handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0) -> +server_ecc_extension(_Version, EcPointFormats) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> - EcPointFormats1 = handle_ecc_point_fmt_extension(EcPointFormats0), - EllipticCurves1 = handle_ecc_curves_extension(Version, EllipticCurves0), - {EcPointFormats1, EllipticCurves1}; - _ -> - {undefined, undefined} + handle_ecc_point_fmt_extension(EcPointFormats); + false -> + undefined end. handle_ecc_point_fmt_extension(undefined) -> @@ -1105,11 +1115,6 @@ handle_ecc_point_fmt_extension(undefined) -> handle_ecc_point_fmt_extension(_) -> #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. -handle_ecc_curves_extension(_Version, undefined) -> - undefined; -handle_ecc_curves_extension(Version, _) -> - #elliptic_curves{elliptic_curve_list = tls_v1:ecc_curves(Version)}. - advertises_ec_ciphers([]) -> false; advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> @@ -1124,6 +1129,22 @@ advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> true; advertises_ec_ciphers([_| Rest]) -> advertises_ec_ciphers(Rest). +select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, + #elliptic_curves{elliptic_curve_list = ServerCurves}) -> + select_curve(ClientCurves, ServerCurves); +select_curve(undefined, _) -> + %% Client did not send ECC extension use default curve if + %% ECC cipher is negotiated + {namedCurve, ?secp256k1}; +select_curve(_, []) -> + no_curve; +select_curve(Curves, [Curve| Rest]) -> + case lists:member(Curve, Curves) of + true -> + {namedCurve, Curve}; + false -> + select_curve(Curves, Rest) + end. %%-------------------------------------------------------------------- %%% Internal functions @@ -1648,3 +1669,4 @@ advertised_hash_signs({Major, Minor}) when Major >= 3 andalso Minor >= 3 -> ({Hash, _}) -> proplists:get_bool(Hash, Hashs) end, HashSigns)}; advertised_hash_signs(_) -> undefined. + diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 3a3ad8cf35..f25b0df806 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -45,7 +45,8 @@ master_secret, srp_username, is_resumable, - time_stamp + time_stamp, + ecc }). -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 5618837506..39595b4f95 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -97,8 +97,7 @@ terminated = false, % allow_renegotiate = true, expecting_next_protocol_negotiation = false :: boolean(), - next_protocol = undefined :: undefined | binary(), - client_ecc % {Curves, PointFmt} + next_protocol = undefined :: undefined | binary() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -405,26 +404,24 @@ hello(#server_hello{cipher_suite = CipherSuite, hello(Hello = #client_hello{client_version = ClientVersion, extensions = #hello_extensions{hash_signs = HashSigns}}, State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, + port = Port, + session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert}, Renegotiation) of + ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, #session{cipher_suite = CipherSuite} = Session}, - ConnectionStates, - #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves} = ServerHelloExt} -> + ConnectionStates, ServerHelloExt} -> {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite), - NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), - do_server_hello(Type, ServerHelloExt, + NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), + do_server_hello(Type, ServerHelloExt, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, - hashsign_algorithm = NegotiatedHashSign, - client_ecc = {EllipticCurves, EcPointFormats}}); + hashsign_algorithm = NegotiatedHashSign}); #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; @@ -1647,12 +1644,13 @@ key_exchange(#state{role = server, key_algorithm = Algo, negotiated_version = Version, tls_handshake_history = Handshake0, socket = Socket, - transport_cb = Transport + transport_cb = Transport, + session = #session{ecc = Curve} } = State) when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa; Algo == ecdh_anon -> - ECDHKeys = public_key:generate_key(select_curve(State)), + ECDHKeys = public_key:generate_key(Curve), ConnectionState = ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, @@ -3086,12 +3084,7 @@ default_hashsign(_Version, KeyExchange) KeyExchange == rsa_psk; KeyExchange == srp_anon -> {null, anon}. - -select_curve(#state{client_ecc = {[Curve|_], _}}) -> - {namedCurve, Curve}; -select_curve(_) -> - {namedCurve, ?secp256k1}. - + is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 02bfa69fc5..6f97da3ccf 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -120,17 +120,16 @@ hello(#client_hello{client_version = ClientVersion, cipher_suites = CipherSuites, compression_methods = Compressions, random = Random, - extensions = HelloExt}, + extensions = #hello_extensions{elliptic_curves = Curves} = HelloExt}, #ssl_options{versions = Versions} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions), case tls_record:is_acceptable_version(Version, Versions) of true -> - %% TODO: need to take supported Curves into Account when selecting the CipherSuite.... - %% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers + ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), {Type, #session{cipher_suite = CipherSuite} = Session1} = ssl_handshake:select_session(SugesstedId, CipherSuites, Compressions, - Port, Session0, Version, + Port, Session0#session{ecc = ECCCurve}, Version, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> -- cgit v1.2.3 From bcff09db98ba696b757139a3fd16050a255182e2 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 8 Oct 2013 09:56:14 +0200 Subject: ssl: Fix dialyzer spec --- lib/ssl/src/tls_handshake.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 6f97da3ccf..ecbca83e10 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -70,7 +70,7 @@ client_hello(Host, Port, ConnectionStates, }. %%-------------------------------------------------------------------- --spec server_hello(#session{}, tls_version(), #connection_states{}, +-spec server_hello(binary(), tls_version(), #connection_states{}, #hello_extensions{}) -> #server_hello{}. %% %% Description: Creates a server hello message. -- cgit v1.2.3 From 41e340fb37d0e660fca70486dc715383df9ba026 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20H=C3=A4ssler?= Date: Thu, 2 May 2013 20:52:30 +0200 Subject: Fix erts erlang.xml doc typo badargif -> badarg if --- erts/doc/src/erlang.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index d3b21de8cf..bc38055b62 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2467,7 +2467,7 @@ os_prompt% fails, a nodedown message is delivered.

Nodes connected through hidden connections can be monitored as any other node.

-

Failure: badargif the local node is not alive.

+

Failure: badarg if the local node is not alive.

-- cgit v1.2.3 From 35cccc7ffe666ee193408b781c19817fee29535a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20H=C3=A4ssler?= Date: Tue, 8 Oct 2013 20:59:30 +0200 Subject: Fix gen_sctp doc typo 'one-to-may' should be 'one-to-many' --- lib/kernel/doc/src/gen_sctp.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 7ea58fffff..33f1c20608 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -322,7 +322,7 @@

Branch off an existing association Assoc in a socket Socket of type seqpacket - (one-to-may style) into + (one-to-many style) into a new socket NewSocket of type stream (one-to-one style).

-- cgit v1.2.3 From 20363d9af0f0f9446d3a1dfb099f4aa1898dc231 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20H=C3=A4ssler?= Date: Mon, 14 Oct 2013 20:42:58 +0200 Subject: Fix ssh doc typos ssh_rsa changed to 'ssh-rsa' and missing space added. --- lib/ssh/doc/src/ssh.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 141d3df38e..fb58a4b014 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -141,7 +141,7 @@

Sets the preferred public key algorithm to use for user authentication. If the the preferred algorithm fails for some reason, the other algorithm is tried. The default is - to try first.

+ to try first.

 @@ -248,7 +248,7 @@ requested by the client. Default is to use the erlang shell: - Provides your own cli implementation, i.e. a channel callback -- cgit v1.2.3 From 23d132911d28206bf413b4b95a0b14e065c5e717 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Wed, 16 Oct 2013 10:29:56 +0200 Subject: Update primary bootstrap --- bootstrap/lib/kernel/ebin/gen_sctp.beam | Bin 3524 -> 3588 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam index 1f33d85cb2..e1384d1b5e 100644 Binary files a/bootstrap/lib/kernel/ebin/gen_sctp.beam and b/bootstrap/lib/kernel/ebin/gen_sctp.beam differ -- cgit v1.2.3 From cf2159e5e43bb989f5a3f5f1b038bfa5ce33057d Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 17 Oct 2013 15:10:48 +0200 Subject: erts: Fix memory leak for distributed monitors --- erts/emulator/beam/dist.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 44f4eb9d43..95d2c5b362 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1509,12 +1509,12 @@ int erts_net_message(Port *prt, break; } rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks); + + erts_destroy_monitor(mon); if (rp == NULL) { break; } - erts_destroy_monitor(mon); - mon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref); if (mon == NULL) { -- cgit v1.2.3 From 1a5586520ff809d49df2a1bca5235e944baaf0e3 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Thu, 17 Oct 2013 12:05:22 +0200 Subject: common_test: Add terminate/1 --- lib/common_test/src/cth_log_redirect.erl | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index f5e769e1ba..8fed341600 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -34,7 +34,7 @@ %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2, code_change/3]). + terminate/1, terminate/2, code_change/3]). %% Other -export([handle_remote_events/1]). @@ -186,10 +186,13 @@ handle_call({handle_remote_events,Bool}, State) -> handle_call(_Query, _State) -> {error, bad_query}. -terminate(_Arg, _State) -> +terminate(_) -> error_logger:delete_report_handler(?MODULE), []. +terminate(_Arg, _State) -> + ok. + tag_event(Event) -> {calendar:local_time(), Event}. -- cgit v1.2.3 From e25f74afd0705f686d0fc949e4362c73d6da15fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 18 Oct 2013 16:47:19 +0200 Subject: erts: Fix segfaulting crashdump writing Crashdumps initiated by out-of-memory on spawn could cause the beam to segfault during crashdump writing due to invalid pointers. The pointers are invalid since the process creation never finished. This commit remedies this problem by removing the process from crashdump printout. --- erts/emulator/beam/break.c | 5 ++++- erts/emulator/beam/erl_process.c | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index ad9a89b642..99604fa3bc 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -76,7 +76,10 @@ process_info(int to, void *to_arg) for (i = 0; i < max; i++) { Process *p = erts_pix2proc(i); if (p && p->i != ENULL) { - if (!ERTS_PROC_IS_EXITING(p)) + /* Do not include processes with no heap, + * they are most likely just created and has invalid data + */ + if (!ERTS_PROC_IS_EXITING(p) && p->heap != NULL) print_process_info(to, to_arg, p); } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 434d5ca147..5cfaf1b5ee 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -7471,6 +7471,7 @@ alloc_process(ErtsRunQueue *rq, erts_aint32_t state) p->approx_started = erts_get_approx_time(); p->rcount = 0; + p->heap = NULL; ASSERT(p == (Process *) (erts_ptab_pix2intptr_nob( @@ -7583,7 +7584,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). hipe_init_process_smp(&p->hipe_smp); #endif #endif - p->heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*sz); p->old_hend = p->old_htop = p->old_heap = NULL; p->high_water = p->heap; -- cgit v1.2.3 From b6f30fea2daa9b3ce76f351d67479e2e69f08b88 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Tue, 22 Oct 2013 10:55:59 +0200 Subject: tools: Add Erlang-specific compilation error regexp for erlang-eunit This defvar was removed in a87a9699735b0a25f99397fba9576f5756da54d3 which made eunit fail on running tests in emacs. --- lib/tools/emacs/erlang-eunit.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index f2c0db67dd..0adeff1a02 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -40,6 +40,10 @@ This is useful, reducing the save-compile-load-test cycle to one keychord.") (defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil)) "Info about the most recent running of an EUnit test representation.") +(defvar erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "*Patterns for matching Erlang errors.") + ;;; ;;; Switch between src/EUnit test buffers ;;; -- cgit v1.2.3 From 1843477391f668eebf0f751282f79fb318567284 Mon Sep 17 00:00:00 2001 From: Peter Andersson Date: Thu, 24 Oct 2013 14:53:16 +0200 Subject: Remove test_server_h from cover spec file --- lib/common_test/test/common_test.cover | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover index 3aa49623e7..87d00c420f 100644 --- a/lib/common_test/test/common_test.cover +++ b/lib/common_test/test/common_test.cover @@ -4,7 +4,6 @@ test_server, test_server_ctrl, test_server_gl, - test_server_h, test_server_io, test_server_node, test_server_sup]}]}. -- cgit v1.2.3 From 8f4d1081433032a16c94c051844b48e22908b895 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A5kan=20Mattsson?= Date: Fri, 25 Oct 2013 09:45:59 +0200 Subject: Add XML marker for regexp syntax --- lib/stdlib/doc/src/re.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml index 71a6e34513..7a9f37ca90 100644 --- a/lib/stdlib/doc/src/re.xml +++ b/lib/stdlib/doc/src/re.xml @@ -40,8 +40,8 @@

This module contains regular expression matching functions for strings and binaries.

-

The regular expression syntax and semantics resemble that of - Perl.

+

The regular expression + syntax and semantics resemble that of Perl.

The library's matching algorithms are currently based on the PCRE library, but not all of the PCRE library is interfaced and @@ -702,7 +702,7 @@ This option makes it possible to include comments inside complicated patterns. N - +

PERL LIKE REGULAR EXPRESSIONS SYNTAX

The following sections contain reference material for the -- cgit v1.2.3 From d54e4318a77c7a42a7b8952780b33987775c7608 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Wed, 25 Sep 2013 14:56:19 +0200 Subject: ssh: Add function ssh:peername/1 with test OTP-11345, sto575, tsk374 --- lib/ssh/doc/src/ssh.xml | 14 ++++++++++++++ lib/ssh/src/ssh.erl | 12 ++++++++++++ lib/ssh/test/ssh_basic_SUITE.erl | 34 +++++++++++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 1 deletion(-) diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index fb58a4b014..ddfb50ebd2 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -333,6 +333,20 @@ + + peername(ConnectionRef) -> {ok, {Address,Port}} | {error,Error} + + + ConnectionRef = ssh_connection_ref() + Address = ip_address() + Port = integer() + + +

Returns the address and port for the other end of a connection. +

+ + + shell(Host) -> shell(Host, Option) -> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 7d5478c3f6..718321ef21 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -28,6 +28,7 @@ -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, + peername/1, stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, shell/1, shell/2, shell/3]). @@ -244,6 +245,17 @@ shell(Host, Port, Options) -> Error end. +%%-------------------------------------------------------------------- +%% Function: peername(ConnectionRef) -> {ok, {Host,Port}} +%% | {error,Error} +%% +%% Description: Returns the peer address of the connection +%%-------------------------------------------------------------------- +peername(ConnectionRef) -> + [{peer, {_Name,{IP,Port}}}] = + ssh_connection_manager:connection_info(ConnectionRef, [peer]), + {ok, {IP,Port}}. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 0aa60624bf..e13610bc2a 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -22,6 +22,7 @@ -module(ssh_basic_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/inet.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -48,7 +49,7 @@ all() -> close]. groups() -> - [{dsa_key, [], [send, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, + [{dsa_key, [], [send, peername, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {rsa_key, [], [send, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, @@ -472,6 +473,37 @@ send(Config) when is_list(Config) -> ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- +peername() -> + [{doc, "Test ssh:peername/1"}]. +peername(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}]), + {ok,{IP,Port}} = ssh:peername(ConnectionRef), + host_equal(Host,IP), + ssh:stop_daemon(Pid). + + +host_equal(Name, IP) when is_list(Name), is_tuple(IP) -> + Family = if size(IP)==4 -> inet; + size(IP)==8 -> inet6 + end, + {ok,#hostent{h_addr_list=IPs}} = inet:gethostbyname(Name,Family), + lists:any(fun(X) -> X==IP end, IPs); +host_equal(IP, Name) when is_list(Name), is_tuple(IP) -> + host_equal(Name, IP); +host_equal(X,Y) -> X==Y. + + %%-------------------------------------------------------------------- close() -> [{doc, "Simulate that we try to close an already closed connection"}]. -- cgit v1.2.3 From f5495aa1560daf65c063a8d5b99a5ea17520ea92 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Mon, 30 Sep 2013 16:35:09 +0200 Subject: ssh: Add ssh:sockname/1 incl doc and tests OTP-11345, sto575, tsk374 --- lib/ssh/doc/src/ssh.xml | 14 +++++++ lib/ssh/src/ssh.erl | 12 ++++++ lib/ssh/src/ssh_connection_handler.erl | 29 +++++++------- lib/ssh/test/Makefile | 5 ++- lib/ssh/test/ssh_basic_SUITE.erl | 55 +++++++++++++++++--------- lib/ssh/test/ssh_peername_sockname_server.erl | 56 +++++++++++++++++++++++++++ 6 files changed, 137 insertions(+), 34 deletions(-) create mode 100644 lib/ssh/test/ssh_peername_sockname_server.erl diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index ddfb50ebd2..896b98edc2 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -366,6 +366,20 @@ + + sockname(ConnectionRef) -> {ok, {Address,Port}} | {error,Error} + + + ConnectionRef = ssh_connection_ref() + Address = ip_address() + Port = integer() + + +

Returns the local address and port number for a connection. +

+ + + start() -> start(Type) -> ok | {error, Reason} diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 718321ef21..80d20abbbd 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -29,6 +29,7 @@ channel_info/3, daemon/1, daemon/2, daemon/3, peername/1, + sockname/1, stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, shell/1, shell/2, shell/3]). @@ -256,6 +257,17 @@ peername(ConnectionRef) -> ssh_connection_manager:connection_info(ConnectionRef, [peer]), {ok, {IP,Port}}. +%%-------------------------------------------------------------------- +%% Function: sockname(ConnectionRef) -> {ok, {Host,Port}} +%% | {error,Error} +%% +%% Description: Returns the local address of the connection +%%-------------------------------------------------------------------- +sockname(ConnectionRef) -> + [{sockname, Result}] = + ssh_connection_manager:connection_info(ConnectionRef, [sockname]), + Result. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 9de4dd5967..c3e8a3c742 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -46,7 +46,7 @@ handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). %% spawn export --export([ssh_info_handler/3]). +-export([ssh_info_handler/4]). -record(state, { transport_protocol, % ex: tcp @@ -533,7 +533,7 @@ handle_event(renegotiate, StateName, State) -> {next_state, StateName, State}; handle_event({info, From, Options}, StateName, #state{ssh_params = Ssh} = State) -> - spawn(?MODULE, ssh_info_handler, [Options, Ssh, From]), + spawn(?MODULE, ssh_info_handler, [Options, Ssh, State, From]), {next_state, StateName, State}; handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> {ok, [{send_oct,Sent}]} = inet:getstat(State#state.socket, [send_oct]), @@ -1022,26 +1022,29 @@ retry_fun(User, Reason, Opts) -> catch Fun(User, Reason) end. -ssh_info_handler(Options, Ssh, From) -> - Info = ssh_info(Options, Ssh, []), +ssh_info_handler(Options, Ssh, State, From) -> + Info = ssh_info(Options, Ssh, State, []), ssh_connection_manager:send_msg({channel_requst_reply, From, Info}). -ssh_info([], _, Acc) -> +ssh_info([], _, _, Acc) -> Acc; ssh_info([client_version | Rest], #ssh{c_vsn = IntVsn, - c_version = StringVsn} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{client_version, {IntVsn, StringVsn}} | Acc]); + c_version = StringVsn} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{client_version, {IntVsn, StringVsn}} | Acc]); ssh_info([server_version | Rest], #ssh{s_vsn = IntVsn, - s_version = StringVsn} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{server_version, {IntVsn, StringVsn}} | Acc]); + s_version = StringVsn} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{server_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([peer | Rest], #ssh{peer = Peer} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{peer, Peer} | Acc]); +ssh_info([peer | Rest], #ssh{peer = Peer} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{peer, Peer} | Acc]); -ssh_info([ _ | Rest], SshParams, Acc) -> - ssh_info(Rest, SshParams, Acc). +ssh_info([sockname | Rest], SshParams, #state{socket=Socket}=State, Acc) -> + ssh_info(Rest, SshParams, State, [{sockname,inet:sockname(Socket)}|Acc]); + +ssh_info([ _ | Rest], SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, Acc). log_error(Reason) -> Report = io_lib:format("Erlang ssh connection handler failed with reason: " diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index f5db31baee..13caafc055 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,8 @@ MODULES= \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ ssh_connection_SUITE \ - ssh_echo_server + ssh_echo_server \ + ssh_peername_sockname_server HRL_FILES_NEEDED_IN_TEST= \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index e13610bc2a..e8f1d5213c 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -49,7 +49,9 @@ all() -> close]. groups() -> - [{dsa_key, [], [send, peername, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, + [{dsa_key, [], [send, + peername_sockname, + exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {rsa_key, [], [send, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, @@ -474,35 +476,50 @@ send(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -peername() -> - [{doc, "Test ssh:peername/1"}]. -peername(Config) when is_list(Config) -> +peername_sockname() -> + [{doc, "Test ssh:peername/1 and ssh:sockname/1"}]. +peername_sockname(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {subsystems, [{"peername_sockname", + {ssh_peername_sockname_server, []}} + ]} + ]), ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user_dir, UserDir}, {user_interaction, false}]), - {ok,{IP,Port}} = ssh:peername(ConnectionRef), - host_equal(Host,IP), - ssh:stop_daemon(Pid). - + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:subsystem(ConnectionRef, ChannelId, "peername_sockname", infinity), + {ok,{HostPeerClient,PortPeerClient}} = ssh:peername(ConnectionRef), + {ok,{HostSockClient,PortSockClient}} = ssh:sockname(ConnectionRef), + receive + {ssh_cm, ConnectionRef, {data, ChannelId, _, Response}} -> + {PeerNameSrv,SockNameSrv} = binary_to_term(Response), + {ok,{HostPeerSrv,PortPeerSrv}} = PeerNameSrv, + {ok,{HostSockSrv,PortSockSrv}} = SockNameSrv, + host_equal(HostPeerSrv, HostSockClient), + PortPeerSrv = PortSockClient, + host_equal(HostSockSrv, HostPeerClient), + PortSockSrv = PortPeerClient, + host_equal(HostSockSrv, Host), + PortSockSrv = Port + after 10000 -> + throw(timeout) + end. -host_equal(Name, IP) when is_list(Name), is_tuple(IP) -> - Family = if size(IP)==4 -> inet; - size(IP)==8 -> inet6 - end, - {ok,#hostent{h_addr_list=IPs}} = inet:gethostbyname(Name,Family), - lists:any(fun(X) -> X==IP end, IPs); -host_equal(IP, Name) when is_list(Name), is_tuple(IP) -> - host_equal(Name, IP); -host_equal(X,Y) -> X==Y. +host_equal(H1, H2) -> + not ordsets:is_disjoint(ips(H1), ips(H2)). +ips(IP) when is_tuple(IP) -> ordsets:from_list([IP]); +ips(Name) when is_list(Name) -> + {ok,#hostent{h_addr_list=IPs4}} = inet:gethostbyname(Name,inet), + {ok,#hostent{h_addr_list=IPs6}} = inet:gethostbyname(Name,inet6), + ordsets:from_list(IPs4++IPs6). %%-------------------------------------------------------------------- close() -> diff --git a/lib/ssh/test/ssh_peername_sockname_server.erl b/lib/ssh/test/ssh_peername_sockname_server.erl new file mode 100644 index 0000000000..7664f3ee25 --- /dev/null +++ b/lib/ssh/test/ssh_peername_sockname_server.erl @@ -0,0 +1,56 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_peername_sockname_server). + +%% The purpose of this module is to perform tests on the server side of an +%% ssh connection. + + +-behaviour(ssh_daemon_channel). +-record(state, {}). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +init([]) -> + {ok, #state{}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + ssh_connection:send(ConnectionManager, ChannelId, + term_to_binary( + {catch ssh:peername(ConnectionManager), + catch ssh:sockname(ConnectionManager) + }) + ), + {ok, State}. + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, + State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _CM, _}, State) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. -- cgit v1.2.3 From e2b0dfac40f2f7f0aa0d74ca902ea5f867c06cd1 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 15 Oct 2013 20:56:37 +0200 Subject: eldap: Add START_TLS (OTP-11336) --- lib/eldap/src/eldap.erl | 91 +++++- lib/eldap/test/README | 36 +++ lib/eldap/test/eldap.cfg | 1 + lib/eldap/test/eldap_basic_SUITE.erl | 174 +++++++++--- lib/eldap/test/eldap_basic_SUITE_data/certs/README | 1 + lib/eldap/test/ldap_server/slapd.conf | 30 +- lib/eldap/test/make_certs.erl | 313 +++++++++++++++++++++ 7 files changed, 583 insertions(+), 63 deletions(-) create mode 100644 lib/eldap/test/README create mode 100644 lib/eldap/test/eldap.cfg create mode 100644 lib/eldap/test/eldap_basic_SUITE_data/certs/README create mode 100644 lib/eldap/test/make_certs.erl diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 8ebb88e35b..5a6813173f 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -6,10 +6,12 @@ %%% draft-ietf-asid-ldap-c-api-00.txt %%% %%% Copyright (c) 2010 Torbjorn Tornkvist +%%% Copyright Ericsson AB 2011-2013. All Rights Reserved. %%% See MIT-LICENSE at the top dir for licensing information. %%% -------------------------------------------------------------------- -vc('$Id$ '). -export([open/1,open/2,simple_bind/3,controlling_process/2, + start_tls/2, start_tls/3, baseObject/0,singleLevel/0,wholeSubtree/0,close/1, equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, approxMatch/2,search/2,substrings/2,present/1, @@ -36,14 +38,16 @@ host, % Host running LDAP server port = ?LDAP_PORT, % The LDAP server port fd, % Socket filedescriptor. + prev_fd, % Socket that was upgraded by start_tls binddn = "", % Name of the entry to bind as passwd, % Password for (above) entry id = 0, % LDAP Request ID log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication - use_tls = false, % LDAP/LDAPS - tls_opts = [] % ssl:ssloption() + ldaps = false, % LDAP/LDAPS + using_tls = false, % true if LDAPS or START_TLS executed + tls_opts = [] % ssl:ssloptsion() }). %%% For debug purposes @@ -76,6 +80,16 @@ open(Hosts, Opts) when is_list(Hosts), is_list(Opts) -> Pid = spawn_link(fun() -> init(Hosts, Opts, Self) end), recv(Pid). +%%% -------------------------------------------------------------------- +%%% Upgrade an existing connection to tls +%%% -------------------------------------------------------------------- +start_tls(Handle, TlsOptions) -> + start_tls(Handle, TlsOptions, infinity). + +start_tls(Handle, TlsOptions, Timeout) -> + send(Handle, {start_tls,TlsOptions,Timeout}), + recv(Handle). + %%% -------------------------------------------------------------------- %%% Shutdown connection (and process) asynchronous. %%% -------------------------------------------------------------------- @@ -351,11 +365,11 @@ parse_args([{anon_auth, true}|T], Cpid, Data) -> parse_args([{anon_auth, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{ssl, true}|T], Cpid, Data) -> - parse_args(T, Cpid, Data#eldap{use_tls = true}); + parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true}); parse_args([{ssl, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> - parse_args(T, Cpid, Data#eldap{use_tls = true, tls_opts = Opts ++ Data#eldap.tls_opts}); + parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true, tls_opts = Opts ++ Data#eldap.tls_opts}); parse_args([{sslopts, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> @@ -386,10 +400,11 @@ try_connect([Host|Hosts], Data) -> try_connect([],_) -> {error,"connect failed"}. -do_connect(Host, Data, Opts) when Data#eldap.use_tls == false -> +do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); -do_connect(Host, Data, Opts) when Data#eldap.use_tls == true -> - ssl:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tls_opts). +do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> + SslOpts = [{verify,0} | Opts ++ Data#eldap.tls_opts], + ssl:connect(Host, Data#eldap.port, SslOpts). loop(Cpid, Data) -> receive @@ -430,6 +445,11 @@ loop(Cpid, Data) -> ?PRINT("New Cpid is: ~p~n",[NewCpid]), ?MODULE:loop(NewCpid, Data); + {From, {start_tls,TlsOptions,Timeout}} -> + {Res,NewData} = do_start_tls(Data, TlsOptions, Timeout), + send(From,Res), + ?MODULE:loop(Cpid, NewData); + {_From, close} -> unlink(Cpid), exit(closed); @@ -444,6 +464,53 @@ loop(Cpid, Data) -> end. + +%%% -------------------------------------------------------------------- +%%% startTLS Request +%%% -------------------------------------------------------------------- + +do_start_tls(Data=#eldap{using_tls=true}, _, _) -> + {{error,tls_already_started}, Data}; +do_start_tls(Data=#eldap{fd=FD} , TlsOptions, Timeout) -> + case catch exec_start_tls(Data) of + {ok,NewData} -> + case ssl:connect(FD,TlsOptions,Timeout) of + {ok, SslSocket} -> + {ok, NewData#eldap{prev_fd = FD, + fd = SslSocket, + using_tls = true + }}; + {error,Error} -> + {{error,Error}, Data} + end; + {error,Error} -> {{error,Error},Data}; + Else -> {{error,Else},Data} + end. + +-define(START_TLS_OID, "1.3.6.1.4.1.1466.20037"). + +exec_start_tls(Data) -> + Req = #'ExtendedRequest'{requestName = ?START_TLS_OID}, + Reply = request(Data#eldap.fd, Data, Data#eldap.id, {extendedReq, Req}), + exec_extended_req_reply(Data, Reply). + +exec_extended_req_reply(Data, {ok,Msg}) when + Msg#'LDAPMessage'.messageID == Data#eldap.id -> + case Msg#'LDAPMessage'.protocolOp of + {extendedResp, Result} -> + case Result#'ExtendedResponse'.resultCode of + success -> + io:format('eldap: exec_start_tls = ~p~n',[success]), + {ok,Data}; + Error -> + io:format('eldap: exec_start_tls = ~p~n',[Error]), + {error, Error} + end; + Other -> {error, Other} + end; +exec_extended_req_reply(_, Error) -> + {error, Error}. + %%% -------------------------------------------------------------------- %%% bindRequest %%% -------------------------------------------------------------------- @@ -685,14 +752,14 @@ send_request(S, Data, ID, Request) -> Else -> Else end. -do_send(S, Data, Bytes) when Data#eldap.use_tls == false -> +do_send(S, Data, Bytes) when Data#eldap.using_tls == false -> gen_tcp:send(S, Bytes); -do_send(S, Data, Bytes) when Data#eldap.use_tls == true -> +do_send(S, Data, Bytes) when Data#eldap.using_tls == true -> ssl:send(S, Bytes). -do_recv(S, #eldap{use_tls=false, timeout=Timeout}, Len) -> +do_recv(S, #eldap{using_tls=false, timeout=Timeout}, Len) -> gen_tcp:recv(S, Len, Timeout); -do_recv(S, #eldap{use_tls=true, timeout=Timeout}, Len) -> +do_recv(S, #eldap{using_tls=true, timeout=Timeout}, Len) -> ssl:recv(S, Len, Timeout). recv_response(S, Data) -> @@ -800,7 +867,7 @@ recv(From) -> {error, {internal_error, Reason}} end. -ldap_closed_p(Data, Emsg) when Data#eldap.use_tls == true -> +ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> %% Check if the SSL socket seems to be alive or not case catch ssl:sockname(Data#eldap.fd) of {error, _} -> diff --git a/lib/eldap/test/README b/lib/eldap/test/README new file mode 100644 index 0000000000..449cdfc0d3 --- /dev/null +++ b/lib/eldap/test/README @@ -0,0 +1,36 @@ + +This works for me on Ubuntu. + +To run thoose test you need + 1) some certificates + 2) a running ldap server, for example OpenLDAPs slapd. See http://www.openldap.org/doc/admin24 + +1)------- +To generate certificates: +erl +> make_certs:all("/dev/null", "eldap_basic_SUITE_data/certs"). + +2)------- +To start slapd: + sudo slapd -f $ERL_TOP/lib/eldap/test/ldap_server/myslapd.conf -F /tmp/slapd/slapd.d -h "ldap://localhost:9876 ldaps://localhost:9877" + +This will however not work, since slapd is guarded by apparmor that checks that slapd does not access other than allowed files... + +To make a local extension of alowed operations: + sudo emacs /etc/apparmor.d/local/usr.sbin.slapd + +and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with an other file) : + + sudo apparmor_parser -r /etc/apparmor.d/usr.sbin.slapd + + +The local file looks like this for me: + +# Site-specific additions and overrides for usr.sbin.slapd. +# For more details, please see /etc/apparmor.d/local/README. + +/etc/pkcs11/** r, +/usr/lib/x86_64-linux-gnu/** rm, + +/ldisk/hans_otp/otp/lib/eldap/test/** rw, +/tmp/slapd/** rwk, diff --git a/lib/eldap/test/eldap.cfg b/lib/eldap/test/eldap.cfg new file mode 100644 index 0000000000..3a24afa067 --- /dev/null +++ b/lib/eldap/test/eldap.cfg @@ -0,0 +1 @@ +{eldap_server,{"localhost",389}}. diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index c7e3052b29..127d753b92 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,39 +27,36 @@ -define(TIMEOUT, 120000). % 2 min -init_per_suite(Config0) -> - {{EldapHost,Port}, Config1} = - case catch ct:get_config(eldap_server, undefined) of - undefined -> %% Dev test only - Server = {"localhost", 9876}, - {Server, [{eldap_server, {"localhost", 9876}}|Config0]}; - {'EXIT', _} -> %% Dev test only - Server = {"localhost", 9876}, - {Server, [{eldap_server, {"localhost", 9876}}|Config0]}; - Server -> - {Server, [{eldap_server, Server}|Config0]} - end, - %% Add path for this test run +init_per_suite(Config) -> + ssl:start(), + chk_config(ldap_server, {"localhost",9876}, + chk_config(ldaps_server, {"localhost",9877}, + Config)). + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config0) -> + {EldapHost,Port} = proplists:get_value(ldap_server,Config0), try - {ok, Handle} = eldap:open([EldapHost], [{port, Port}]), + {ok, Handle} = eldap:open([EldapHost], [{port,Port}]), ok = eldap:simple_bind(Handle, "cn=Manager,dc=ericsson,dc=se", "hejsan"), {ok, MyHost} = inet:gethostname(), Path = "dc="++MyHost++",dc=ericsson,dc=se", - Config = [{eldap_path,Path}|Config1], eldap:add(Handle,"dc=ericsson,dc=se", [{"objectclass", ["dcObject", "organization"]}, {"dc", ["ericsson"]}, {"o", ["Testing"]}]), eldap:add(Handle,Path, [{"objectclass", ["dcObject", "organization"]}, {"dc", [MyHost]}, {"o", ["Test machine"]}]), - Config + [{eldap_path,Path}|Config0] catch error:{badmatch,Error} -> io:format("Eldap init error ~p~n ~p~n",[Error, erlang:get_stacktrace()]), - {skip, lists:flatten(io_lib:format("Ldap init failed with host ~p", [EldapHost]))} + {skip, lists:flatten(io_lib:format("Ldap init failed with host ~p:~p. Error=~p", [EldapHost,Port,Error]))} end. -end_per_suite(Config) -> - %% Cleanup everything - {EHost, Port} = proplists:get_value(eldap_server, Config), + +end_per_testcase(_TestCase, Config) -> + {EHost, Port} = proplists:get_value(ldap_server, Config), Path = proplists:get_value(eldap_path, Config), {ok, H} = eldap:open([EHost], [{port, Port}]), ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), @@ -71,16 +68,20 @@ end_per_suite(Config) -> [ok = eldap:delete(H, Entry) || {eldap_entry, Entry, _} <- Entries]; _ -> ignore end, - ok. -init_per_testcase(_TestCase, Config) -> Config. -end_per_testcase(_TestCase, _Config) -> ok. + ok. %% suite() -> all() -> [app, - api]. + api, + ssl_api, + start_tls, + tls_operations, + start_tls_twice, + start_tls_on_ssl + ]. app(doc) -> "Test that the eldap app file is ok"; app(suite) -> []; @@ -90,21 +91,89 @@ app(Config) when is_list(Config) -> api(doc) -> "Basic test that all api functions works as expected"; api(suite) -> []; api(Config) -> - {Host,Port} = proplists:get_value(eldap_server, Config), + {Host,Port} = proplists:get_value(ldap_server, Config), {ok, H} = eldap:open([Host], [{port,Port}]), %% {ok, H} = eldap:open([Host], [{port,Port+1}, {ssl, true}]), + do_api_checks(H, Config), + eldap:close(H), + ok. + + +ssl_api(doc) -> "Basic test that all api functions works as expected"; +ssl_api(suite) -> []; +ssl_api(Config) -> + {Host,Port} = proplists:get_value(ldaps_server, Config), + {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), + do_api_checks(H, Config), + eldap:close(H), + ok. + + +start_tls(doc) -> "Test that an existing (tcp) connection can be upgraded to tls"; +start_tls(suite) -> []; +start_tls(Config) -> + {Host,Port} = proplists:get_value(ldap_server, Config), + {ok, H} = eldap:open([Host], [{port,Port}]), + ok = eldap:start_tls(H, [ + {keyfile, filename:join([proplists:get_value(data_dir,Config), + "certs/client/key.pem"])} + ]), + eldap:close(H). + + +tls_operations(doc) -> "Test that an upgraded connection is usable for ldap stuff"; +tls_operations(suite) -> []; +tls_operations(Config) -> + {Host,Port} = proplists:get_value(ldap_server, Config), + {ok, H} = eldap:open([Host], [{port,Port}]), + ok = eldap:start_tls(H, [ + {keyfile, filename:join([proplists:get_value(data_dir,Config), + "certs/client/key.pem"])} + ]), + do_api_checks(H, Config), + eldap:close(H). + +start_tls_twice(doc) -> "Test that start_tls on an already upgraded connection fails"; +start_tls_twice(suite) -> []; +start_tls_twice(Config) -> + {Host,Port} = proplists:get_value(ldap_server, Config), + {ok, H} = eldap:open([Host], [{port,Port}]), + ok = eldap:start_tls(H, []), + {error,tls_already_started} = eldap:start_tls(H, []), + do_api_checks(H, Config), + eldap:close(H). + + +start_tls_on_ssl(doc) -> "Test that start_tls on an ldaps connection fails"; +start_tls_on_ssl(suite) -> []; +start_tls_on_ssl(Config) -> + {Host,Port} = proplists:get_value(ldaps_server, Config), + {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), + {error,tls_already_started} = eldap:start_tls(H, []), + do_api_checks(H, Config), + eldap:close(H). + + +%%%-------------------------------------------------------------------------------- +chk_config(Key, Default, Config) -> + case catch ct:get_config(ldap_server, undefined) of + undefined -> [{Key,Default} | Config ]; + {'EXIT',_} -> [{Key,Default} | Config ]; + Value -> [{Key,Value} | Config] + end. + + + +do_api_checks(H, Config) -> BasePath = proplists:get_value(eldap_path, Config), + All = fun(Where) -> eldap:search(H, #eldap_search{base=Where, filter=eldap:present("objectclass"), scope= eldap:wholeSubtree()}) end, - Search = fun(Filter) -> - eldap:search(H, #eldap_search{base=BasePath, - filter=Filter, - scope=eldap:singleLevel()}) - end, - {ok, #eldap_search_result{entries=[_]}} = All(BasePath), + {ok, #eldap_search_result{entries=[_XYZ]}} = All(BasePath), +%% ct:log("XYZ=~p",[_XYZ]), {error, noSuchObject} = All("cn=Bar,"++BasePath), {error, _} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, @@ -112,52 +181,67 @@ api(Config) -> {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - %% Add + chk_add(H, BasePath), + {ok,FB} = chk_search(H, BasePath), + chk_modify(H, FB), + chk_delete(H, BasePath), + chk_modify_dn(H, FB). + + +chk_add(H, BasePath) -> ok = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, [{"objectclass", ["person"]}, {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), + {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), ok = eldap:add(H, "cn=Foo Bar," ++ BasePath, [{"objectclass", ["person"]}, {"cn", ["Foo Bar"]}, {"sn", ["Bar"]}, {"telephoneNumber", ["555-1232", "555-5432"]}]), ok = eldap:add(H, "ou=Team," ++ BasePath, [{"objectclass", ["organizationalUnit"]}, - {"ou", ["Team"]}]), + {"ou", ["Team"]}]). - %% Search +chk_search(H, BasePath) -> + Search = fun(Filter) -> + eldap:search(H, #eldap_search{base=BasePath, + filter=Filter, + scope=eldap:singleLevel()}) + end, JJSR = {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:equalityMatch("sn", "Jonsson")), JJSR = Search(eldap:substrings("sn", [{any, "ss"}])), FBSR = {ok, #eldap_search_result{entries=[#eldap_entry{object_name=FB}]}} = Search(eldap:substrings("sn", [{any, "a"}])), FBSR = Search(eldap:substrings("sn", [{initial, "B"}])), FBSR = Search(eldap:substrings("sn", [{final, "r"}])), - F_AND = eldap:'and'([eldap:present("objectclass"), eldap:present("ou")]), {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(F_AND), F_NOT = eldap:'and'([eldap:present("objectclass"), eldap:'not'(eldap:present("ou"))]), {ok, #eldap_search_result{entries=[#eldap_entry{}, #eldap_entry{}]}} = Search(F_NOT), + {ok,FB}. %% FIXME - %% MODIFY +chk_modify(H, FB) -> Mod = [eldap:mod_replace("telephoneNumber", ["555-12345"]), eldap:mod_add("description", ["Nice guy"])], %% io:format("MOD ~p ~p ~n",[FB, Mod]), ok = eldap:modify(H, FB, Mod), %% DELETE ATTR - ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]), + ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]). - %% DELETE + +chk_delete(H, BasePath) -> {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, [{"objectclass", ["person"]}, {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), ok = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath), - {error, noSuchObject} = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath), + {error, noSuchObject} = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath). - %% MODIFY_DN - ok = eldap:modify_dn(H, FB, "cn=Niclas Andre", true, ""), - %%io:format("Res ~p~n ~p~n",[R, All(BasePath)]), +chk_modify_dn(H, FB) -> + ok = eldap:modify_dn(H, FB, "cn=Niclas Andre", true, ""). + %%io:format("Res ~p~n ~p~n",[R, All(BasePath)]). - eldap:close(H), - ok. +%%%---------------- add(H, Attr, Value, Path0, Attrs, Class) -> Path = case Path0 of [] -> Attr ++ "=" ++ Value; diff --git a/lib/eldap/test/eldap_basic_SUITE_data/certs/README b/lib/eldap/test/eldap_basic_SUITE_data/certs/README new file mode 100644 index 0000000000..a7c8e9dc2e --- /dev/null +++ b/lib/eldap/test/eldap_basic_SUITE_data/certs/README @@ -0,0 +1 @@ +See ../../README diff --git a/lib/eldap/test/ldap_server/slapd.conf b/lib/eldap/test/ldap_server/slapd.conf index 87be676d9f..eca298c866 100644 --- a/lib/eldap/test/ldap_server/slapd.conf +++ b/lib/eldap/test/ldap_server/slapd.conf @@ -1,14 +1,32 @@ -include /etc/ldap/schema/core.schema -pidfile /tmp/openldap-data/slapd.pid -argsfile /tmp/openldap-data/slapd.args +modulepath /usr/lib/ldap +moduleload back_bdb.la + +# example config file - global configuration section +include /etc/ldap/schema/core.schema +referral ldap://root.openldap.org +access to * by * read + +TLSCACertificateFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/cacerts.pem +TLSCertificateFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/cert.pem +TLSCertificateKeyFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/keycert.pem + database bdb suffix "dc=ericsson,dc=se" rootdn "cn=Manager,dc=ericsson,dc=se" rootpw hejsan + # The database must exist before running slapd -directory /tmp/openldap-data +directory /tmp/slapd/openldap-data-ericsson.se + # Indices to maintain index objectClass eq -# URI "ldap://0.0.0.0:9876 ldaps://0.0.0.0:9870" -# servers/slapd/slapd -d 255 -h "ldap://0.0.0.0:9876 ldaps://0.0.0.0:9870" -f /ldisk/dgud/src/otp/lib/eldap/test/ldap_server/slapd.conf \ No newline at end of file +access to attrs=userPassword + by self write + by anonymous auth + by dn.base="cn=Manager,dc=ericsson,dc=se" write + by * none +access to * + by self write + by dn.base="cn=Manager,dc=ericsson,dc=se" write + by * read diff --git a/lib/eldap/test/make_certs.erl b/lib/eldap/test/make_certs.erl new file mode 100644 index 0000000000..f963af180d --- /dev/null +++ b/lib/eldap/test/make_certs.erl @@ -0,0 +1,313 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(make_certs). + +-export([all/2]). + +-record(dn, {commonName, + organizationalUnitName = "Erlang OTP", + organizationName = "Ericsson AB", + localityName = "Stockholm", + countryName = "SE", + emailAddress = "peter@erix.ericsson.se"}). + +all(DataDir, PrivDir) -> + OpenSSLCmd = "openssl", + create_rnd(DataDir, PrivDir), % For all requests + rootCA(PrivDir, OpenSSLCmd, "erlangCA"), + intermediateCA(PrivDir, OpenSSLCmd, "otpCA", "erlangCA"), + endusers(PrivDir, OpenSSLCmd, "otpCA", ["client", "server"]), + collect_certs(PrivDir, ["erlangCA", "otpCA"], ["client", "server"]), + %% Create keycert files + SDir = filename:join([PrivDir, "server"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + append_files([SK, SC], SKC), + CDir = filename:join([PrivDir, "client"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + append_files([CK, CC], CKC), + remove_rnd(PrivDir). + +append_files(FileNames, ResultFileName) -> + {ok, ResultFile} = file:open(ResultFileName, [write]), + do_append_files(FileNames, ResultFile). + +do_append_files([], RF) -> + ok = file:close(RF); +do_append_files([F|Fs], RF) -> + {ok, Data} = file:read_file(F), + ok = file:write(RF, Data), + do_append_files(Fs, RF). + +rootCA(Root, OpenSSLCmd, Name) -> + create_ca_dir(Root, Name, ca_cnf(Name)), + DN = #dn{commonName = Name}, + create_self_signed_cert(Root, OpenSSLCmd, Name, req_cnf(DN)), + ok. + +intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> + CA = "otpCA", + create_ca_dir(Root, CA, ca_cnf(CA)), + CARoot = filename:join([Root, CA]), + DN = #dn{commonName = CA}, + CnfFile = filename:join([CARoot, "req.cnf"]), + file:write_file(CnfFile, req_cnf(DN)), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + ReqFile = filename:join([CARoot, "req.pem"]), + create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + CertFile = filename:join([CARoot, "cert.pem"]), + sign_req(Root, OpenSSLCmd, ParentCA, "ca_cert", ReqFile, CertFile). + +endusers(Root, OpenSSLCmd, CA, Users) -> + lists:foreach(fun(User) -> enduser(Root, OpenSSLCmd, CA, User) end, Users). + +enduser(Root, OpenSSLCmd, CA, User) -> + UsrRoot = filename:join([Root, User]), + file:make_dir(UsrRoot), + CnfFile = filename:join([UsrRoot, "req.cnf"]), + DN = #dn{commonName = User}, + file:write_file(CnfFile, req_cnf(DN)), + KeyFile = filename:join([UsrRoot, "key.pem"]), + ReqFile = filename:join([UsrRoot, "req.pem"]), + create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + CertFileAllUsage = filename:join([UsrRoot, "cert.pem"]), + sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFileAllUsage), + CertFileDigitalSigOnly = filename:join([UsrRoot, "digital_signature_only_cert.pem"]), + sign_req(Root, OpenSSLCmd, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly). + +collect_certs(Root, CAs, Users) -> + Bins = lists:foldr( + fun(CA, Acc) -> + File = filename:join([Root, CA, "cert.pem"]), + {ok, Bin} = file:read_file(File), + [Bin, "\n" | Acc] + end, [], CAs), + lists:foreach( + fun(User) -> + File = filename:join([Root, User, "cacerts.pem"]), + file:write_file(File, Bins) + end, Users). + +create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> + CARoot = filename:join([Root, CAName]), + CnfFile = filename:join([CARoot, "req.cnf"]), + file:write_file(CnfFile, Cnf), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [OpenSSLCmd, " req" + " -new" + " -x509" + " -config ", CnfFile, + " -keyout ", KeyFile, + " -out ", CertFile], + Env = [{"ROOTDIR", Root}], + cmd(Cmd, Env), + fix_key_file(OpenSSLCmd, KeyFile). + +% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format +fix_key_file(OpenSSLCmd, KeyFile) -> + KeyFileTmp = KeyFile ++ ".tmp", + Cmd = [OpenSSLCmd, " rsa", + " -in ", + KeyFile, + " -out ", + KeyFileTmp], + cmd(Cmd, []), + ok = file:rename(KeyFileTmp, KeyFile). + +create_ca_dir(Root, CAName, Cnf) -> + CARoot = filename:join([Root, CAName]), + file:make_dir(CARoot), + create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), + create_rnd(Root, filename:join([CAName, "private"])), + create_files(CARoot, [{"serial", "01\n"}, + {"index.txt", ""}, + {"ca.cnf", Cnf}]). + +create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> + Cmd = [OpenSSLCmd, " req" + " -new" + " -config ", CnfFile, + " -keyout ", KeyFile, + " -out ", ReqFile], + Env = [{"ROOTDIR", Root}], + cmd(Cmd, Env), + fix_key_file(OpenSSLCmd, KeyFile). + +sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + Cmd = [OpenSSLCmd, " ca" + " -batch" + " -notext" + " -config ", CACnfFile, + " -extensions ", CertType, + " -in ", ReqFile, + " -out ", CertFile], + Env = [{"ROOTDIR", Root}], + cmd(Cmd, Env). + +%% +%% Misc +%% + +create_dirs(Root, Dirs) -> + lists:foreach(fun(Dir) -> + file:make_dir(filename:join([Root, Dir])) end, + Dirs). + +create_files(Root, NameContents) -> + lists:foreach( + fun({Name, Contents}) -> + file:write_file(filename:join([Root, Name]), Contents) end, + NameContents). + +create_rnd(FromDir, ToDir) -> + From = filename:join([FromDir, "RAND"]), + To = filename:join([ToDir, "RAND"]), + file:copy(From, To). + +remove_rnd(Dir) -> + File = filename:join([Dir, "RAND"]), + file:delete(File). + +cmd(Cmd, Env) -> + FCmd = lists:flatten(Cmd), + Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, + {env, Env}]), + eval_cmd(Port). + +eval_cmd(Port) -> + receive + {Port, {data, _}} -> + eval_cmd(Port); + {Port, eof} -> + ok + end, + receive + {Port, {exit_status, Status}} when Status /= 0 -> + %% io:fwrite("exit status: ~w~n", [Status]), + exit({eval_cmd, Status}) + after 0 -> + ok + end. + +%% +%% Contents of configuration files +%% + +req_cnf(DN) -> + ["# Purpose: Configuration for requests (end users and CAs)." + "\n" + "ROOTDIR = $ENV::ROOTDIR\n" + "\n" + + "[req]\n" + "input_password = secret\n" + "output_password = secret\n" + "default_bits = 1024\n" + "RANDFILE = $ROOTDIR/RAND\n" + "encrypt_key = no\n" + "default_md = sha1\n" + "#string_mask = pkix\n" + "x509_extensions = ca_ext\n" + "prompt = no\n" + "distinguished_name= name\n" + "\n" + + "[name]\n" + "commonName = ", DN#dn.commonName, "\n" + "organizationalUnitName = ", DN#dn.organizationalUnitName, "\n" + "organizationName = ", DN#dn.organizationName, "\n" + "localityName = ", DN#dn.localityName, "\n" + "countryName = ", DN#dn.countryName, "\n" + "emailAddress = ", DN#dn.emailAddress, "\n" + "\n" + + "[ca_ext]\n" + "basicConstraints = critical, CA:true\n" + "keyUsage = cRLSign, keyCertSign\n" + "subjectKeyIdentifier = hash\n" + "subjectAltName = email:copy\n"]. + + +ca_cnf(CA) -> + ["# Purpose: Configuration for CAs.\n" + "\n" + "ROOTDIR = $ENV::ROOTDIR\n" + "default_ca = ca\n" + "\n" + + "[ca]\n" + "dir = $ROOTDIR/", CA, "\n" + "certs = $dir/certs\n" + "crl_dir = $dir/crl\n" + "database = $dir/index.txt\n" + "new_certs_dir = $dir/newcerts\n" + "certificate = $dir/cert.pem\n" + "serial = $dir/serial\n" + "crl = $dir/crl.pem\n" + "private_key = $dir/private/key.pem\n" + "RANDFILE = $dir/private/RAND\n" + "\n" + "x509_extensions = user_cert\n" + "unique_subject = no\n" + "default_days = 3600\n" + "default_md = sha1\n" + "preserve = no\n" + "policy = policy_match\n" + "\n" + + "[policy_match]\n" + "commonName = supplied\n" + "organizationalUnitName = optional\n" + "organizationName = match\n" + "countryName = match\n" + "localityName = match\n" + "emailAddress = supplied\n" + "\n" + + "[user_cert]\n" + "basicConstraints = CA:false\n" + "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n" + "\n" + + "[user_cert_digital_signature_only]\n" + "basicConstraints = CA:false\n" + "keyUsage = digitalSignature\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n" + "\n" + + "[ca_cert]\n" + "basicConstraints = critical,CA:true\n" + "keyUsage = cRLSign, keyCertSign\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid:always,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n"]. -- cgit v1.2.3 From f826e32a196a11729350aa4e27c1fee7a918876b Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 15 Oct 2013 21:29:55 +0200 Subject: eldap: Changed instruction in test/README --- lib/eldap/test/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/eldap/test/README b/lib/eldap/test/README index 449cdfc0d3..8774db1504 100644 --- a/lib/eldap/test/README +++ b/lib/eldap/test/README @@ -12,7 +12,7 @@ erl 2)------- To start slapd: - sudo slapd -f $ERL_TOP/lib/eldap/test/ldap_server/myslapd.conf -F /tmp/slapd/slapd.d -h "ldap://localhost:9876 ldaps://localhost:9877" + sudo slapd -f $ERL_TOP/lib/eldap/test/ldap_server/slapd.conf -F /tmp/slapd/slapd.d -h "ldap://localhost:9876 ldaps://localhost:9877" This will however not work, since slapd is guarded by apparmor that checks that slapd does not access other than allowed files... -- cgit v1.2.3 From 0f89fe517d751e38ebc3201193d53934aed4413b Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Wed, 16 Oct 2013 15:57:33 +0200 Subject: eldap: Minor change (error code) --- lib/eldap/src/eldap.erl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 5a6813173f..27246996e3 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -500,11 +500,9 @@ exec_extended_req_reply(Data, {ok,Msg}) when {extendedResp, Result} -> case Result#'ExtendedResponse'.resultCode of success -> - io:format('eldap: exec_start_tls = ~p~n',[success]), {ok,Data}; - Error -> - io:format('eldap: exec_start_tls = ~p~n',[Error]), - {error, Error} + Error -> + {error, {response,Error}} end; Other -> {error, Other} end; -- cgit v1.2.3 From b53bdc5c149d2a05a8fa28e663f042049c0bdabd Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Wed, 16 Oct 2013 15:58:39 +0200 Subject: eldap: Doc --- lib/eldap/doc/src/eldap.xml | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 30767abd7e..bb107822b3 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -35,6 +35,7 @@

References:

RFC 4510 - RFC 4519

 +

RFC 2830

The above publications can be found at IETF.

@@ -86,6 +87,34 @@ filter() See present/1, substrings/2,

Shutdown the connection.

 + + start_tls(Handle, Options) -> ok | {error,Error} + Shutdown the connection. + +

Same as start_tls(Handle, Options, infinity)

+ + + + start_tls(Handle, Options, Timeout) -> ok | {error,Error} + Shutdown the connection. + + Handle = handle() + Options = ssl:ssl_options() + Timeout = inifinity | positive_integer() + + +

Upgrade the connection associated with Handle to a tls connection if possible.

+

Among the Error responses we find:

+ + tls_already_started + The connection is already encrypted. The connection is not affected. + {response,ResponseFromServer} + The upgrade was refused by the LDAP server. The ResponseFromServer is an atom delivered byt the LDAP server explained in section 2.3 of rfc 2830. The connection is not affected, so it is still un-encrypted. + Error + Any error responded from ssl:connect/3 + + + simple_bind(Handle, Dn, Password) -> ok | {error, Reason} Authenticate the connection. -- cgit v1.2.3 From 0d41b12e62f285d1c5317b4c6396737d601191bc Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Mon, 28 Oct 2013 16:44:05 +0100 Subject: eldap: minor doc change after review. --- lib/eldap/doc/src/eldap.xml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index bb107822b3..5b81716543 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -89,14 +89,14 @@ filter() See present/1, substrings/2, start_tls(Handle, Options) -> ok | {error,Error} - Shutdown the connection. + Upgrade a connection to TLS.

Same as start_tls(Handle, Options, infinity)

 start_tls(Handle, Options, Timeout) -> ok | {error,Error} - Shutdown the connection. + Upgrade a connection to TLS. Handle = handle() Options = ssl:ssl_options() @@ -104,12 +104,16 @@ filter() See present/1, substrings/2,

Upgrade the connection associated with Handle to a tls connection if possible.

-

Among the Error responses we find:

+

The upgrade is done in two phases: first the server is asked for permission to upgrade. Second, if the request is acknowledged, the upgrade is performed.

+

Error responese from phase one will not affect the current encryption state of the connection. Those responses are:

tls_already_started The connection is already encrypted. The connection is not affected. {response,ResponseFromServer} The upgrade was refused by the LDAP server. The ResponseFromServer is an atom delivered byt the LDAP server explained in section 2.3 of rfc 2830. The connection is not affected, so it is still un-encrypted. + +

Errors in the seconde phase will however end the connection:

+ Error Any error responded from ssl:connect/3 -- cgit v1.2.3 From ee47ef6189651ffadebc3fad0933f12017e5de59 Mon Sep 17 00:00:00 2001 From: Hans Nilsson Date: Tue, 29 Oct 2013 15:26:39 +0100 Subject: eldap: re-fixed earlier bug fix... --- lib/eldap/src/eldap.erl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 27246996e3..af5bf94c97 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -47,7 +47,7 @@ anon_auth = false, % Allow anonymous authentication ldaps = false, % LDAP/LDAPS using_tls = false, % true if LDAPS or START_TLS executed - tls_opts = [] % ssl:ssloptsion() + tls_opts = [] % ssl:ssloption() }). %%% For debug purposes @@ -403,8 +403,7 @@ try_connect([],_) -> do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> - SslOpts = [{verify,0} | Opts ++ Data#eldap.tls_opts], - ssl:connect(Host, Data#eldap.port, SslOpts). + ssl:connect(Host, Data#eldap.port, Opts++Data#eldap.tls_opts). loop(Cpid, Data) -> receive -- cgit v1.2.3 From 8062b794c04ad5ed9933caaaac509872823ab8d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pe=CC=81ter=20Go=CC=88mo=CC=88ri?= Date: Wed, 10 Jul 2013 01:58:52 +0100 Subject: Take compiler options from beam in cover:compile_beam Similarly to cover compiling from source (in this case some user specified compiler options are allowed) when cover compiling from existing beam take a filtered list of compiler options from the beamfile. This way e.g. export_all can be preserved. See use case in eb02beb1c3 --- lib/tools/src/cover.erl | 44 ++++++++++++++++++++++++------------- lib/tools/test/cover_SUITE.erl | 49 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 76 insertions(+), 17 deletions(-) diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index bf21aa6b48..13d9aefb0c 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -255,16 +255,7 @@ compile_directory(Dir, Options) when is_list(Dir), is_list(Options) -> end. compile_modules(Files,Options) -> - Options2 = lists:filter(fun(Option) -> - case Option of - {i, Dir} when is_list(Dir) -> true; - {d, _Macro} -> true; - {d, _Macro, _Value} -> true; - export_all -> true; - _ -> false - end - end, - Options), + Options2 = filter_options(Options), compile_modules(Files,Options2,[]). compile_modules([File|Files], Options, Result) -> @@ -273,6 +264,17 @@ compile_modules([File|Files], Options, Result) -> compile_modules([],_Opts,Result) -> reverse(Result). +filter_options(Options) -> + lists:filter(fun(Option) -> + case Option of + {i, Dir} when is_list(Dir) -> true; + {d, _Macro} -> true; + {d, _Macro, _Value} -> true; + export_all -> true; + _ -> false + end + end, + Options). %% compile_beam(ModFile) -> Result | {error,Reason} %% ModFile - see compile/1 @@ -622,8 +624,9 @@ main_process_loop(State) -> Compiled0 = State#main_state.compiled, case get_beam_file(Module,BeamFile0,Compiled0) of {ok,BeamFile} -> + UserOptions = get_compile_options(Module,BeamFile), {Reply,Compiled} = - case do_compile_beam(Module,BeamFile,[]) of + case do_compile_beam(Module,BeamFile,UserOptions) of {ok, Module} -> remote_load_compiled(State#main_state.nodes, [{Module,BeamFile}]), @@ -1421,12 +1424,23 @@ get_abstract_code(Module, Beam) -> end. get_source_info(Module, Beam) -> + Compile = get_compile_info(Module, Beam), + case lists:keyfind(source, 1, Compile) of + { source, _ } = Tuple -> [Tuple]; + false -> [] + end. + +get_compile_options(Module, Beam) -> + Compile = get_compile_info(Module, Beam), + case lists:keyfind(options, 1, Compile) of + {options, Options } -> filter_options(Options); + false -> [] + end. + +get_compile_info(Module, Beam) -> case beam_lib:chunks(Beam, [compile_info]) of {ok, {Module, [{compile_info, Compile}]}} -> - case lists:keyfind(source, 1, Compile) of - { source, _ } = Tuple -> [Tuple]; - false -> [] - end; + Compile; _ -> [] end. diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index c033be98a3..7925a47d4f 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -28,7 +28,7 @@ export_import/1, otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1]). + otp_10979_hanging_node/1, compile_beam_opts/1]). -include_lib("test_server/include/test_server.hrl"). @@ -53,7 +53,7 @@ all() -> dont_reconnect_after_stop, stop_node_after_disconnect, export_import, otp_5031, eif, otp_5305, otp_5418, otp_6115, otp_7095, otp_8188, otp_8270, otp_8273, - otp_8340, otp_10979_hanging_node]; + otp_8340, otp_10979_hanging_node, compile_beam_opts]; _pid -> {skip, "It looks like the test server is running " @@ -1401,6 +1401,51 @@ otp_10979_hanging_node(_Config) -> ok. +compile_beam_opts(doc) -> + ["Take compiler options from beam in cover:compile_beam"]; +compile_beam_opts(suite) -> []; +compile_beam_opts(Config) when is_list(Config) -> + ?line ok = file:set_cwd(?config(priv_dir, Config)), + ?line IncDir = filename:join(?config(data_dir, Config), + "included_functions"), + File = "t.erl", + Test = <<"-module(t). + -export([exported/0]). + -include(\"cover_inc.hrl\"). + -ifdef(BOOL). + macro() -> + ?MACRO. + -endif. + exported() -> + ok. + nonexported() -> + ok. + ">>, + ?line ok = file:write_file(File, Test), + %% use all compiler options allowed by cover:filter_options + %% i and d don't make sense when compiling from beam though + ?line {ok, t} = + compile:file(File, [{i, IncDir}, + {d, 'BOOL'}, + {d, 'MACRO', macro_defined}, + export_all, + debug_info, + return_errors]), + Exports = + [{func1,0}, + {macro, 0}, + {exported,0}, + {nonexported,0}, + {module_info,0}, + {module_info,1}], + ?line Exports = t:module_info(exports), + ?line {ok, t} = cover:compile_beam("t"), + ?line Exports = t:module_info(exports), + ?line cover:stop(), + ?line ok = file:delete(File), + + ok. + %%--Auxiliary------------------------------------------------------------ analyse_expr(Expr, Config) -> -- cgit v1.2.3 From dc672094a5c926b1b4a656c13b688bb8c06f7a3b Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Fri, 25 Oct 2013 09:14:34 +0200 Subject: tools: Fix compile_beam_opts testcase --- lib/tools/test/cover_SUITE.erl | 34 ++++++++----------------- lib/tools/test/cover_SUITE_data/otp_11439/t.erl | 11 ++++++++ 2 files changed, 22 insertions(+), 23 deletions(-) create mode 100644 lib/tools/test/cover_SUITE_data/otp_11439/t.erl diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 7925a47d4f..29b26c7a76 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1405,26 +1405,14 @@ compile_beam_opts(doc) -> ["Take compiler options from beam in cover:compile_beam"]; compile_beam_opts(suite) -> []; compile_beam_opts(Config) when is_list(Config) -> - ?line ok = file:set_cwd(?config(priv_dir, Config)), - ?line IncDir = filename:join(?config(data_dir, Config), + {ok, Cwd} = file:get_cwd(), + ok = file:set_cwd(?config(priv_dir, Config)), + IncDir = filename:join(?config(data_dir, Config), "included_functions"), - File = "t.erl", - Test = <<"-module(t). - -export([exported/0]). - -include(\"cover_inc.hrl\"). - -ifdef(BOOL). - macro() -> - ?MACRO. - -endif. - exported() -> - ok. - nonexported() -> - ok. - ">>, - ?line ok = file:write_file(File, Test), + File = filename:join([?config(data_dir, Config), "otp_11439", "t.erl"]), %% use all compiler options allowed by cover:filter_options %% i and d don't make sense when compiling from beam though - ?line {ok, t} = + {ok, t} = compile:file(File, [{i, IncDir}, {d, 'BOOL'}, {d, 'MACRO', macro_defined}, @@ -1438,12 +1426,12 @@ compile_beam_opts(Config) when is_list(Config) -> {nonexported,0}, {module_info,0}, {module_info,1}], - ?line Exports = t:module_info(exports), - ?line {ok, t} = cover:compile_beam("t"), - ?line Exports = t:module_info(exports), - ?line cover:stop(), - ?line ok = file:delete(File), - + Exports = t:module_info(exports), + {ok, t} = cover:compile_beam("t"), + Exports = t:module_info(exports), + cover:stop(), + ok = file:delete("t.beam"), + ok = file:set_cwd(Cwd), ok. %%--Auxiliary------------------------------------------------------------ diff --git a/lib/tools/test/cover_SUITE_data/otp_11439/t.erl b/lib/tools/test/cover_SUITE_data/otp_11439/t.erl new file mode 100644 index 0000000000..d1eb9f16ee --- /dev/null +++ b/lib/tools/test/cover_SUITE_data/otp_11439/t.erl @@ -0,0 +1,11 @@ +-module(t). +-export([exported/0]). +-include("cover_inc.hrl"). +-ifdef(BOOL). +macro() -> + ?MACRO. +-endif. +exported() -> + ok. +nonexported() -> + ok. -- cgit v1.2.3 From ded2289a475af4eacb0ad363990282cdac2ede37 Mon Sep 17 00:00:00 2001 From: Jakub Date: Tue, 29 Oct 2013 10:57:42 +0000 Subject: Update INSTALL.md Added info how to generate configure file if building from git. --- HOWTO/INSTALL.md | 1 + 1 file changed, 1 insertion(+) diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 5bde47e1f6..07a8db1a53 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -217,6 +217,7 @@ Step 4: Run the following commands to configure the build: $ ./configure [ options ] +If you are building it from git you will need to run `autoconf` to generate configure file. By default, Erlang/OTP will be installed in `/usr/local/{bin,lib/erlang}`. To instead install in `/{bin,lib/erlang}`, use the `--prefix=` option. -- cgit v1.2.3 From fd60460ddcbc83907768ec00c234c5e28a7fa549 Mon Sep 17 00:00:00 2001 From: Ken Key Date: Tue, 29 Oct 2013 07:35:44 -1000 Subject: Remove extraneous dev debug code left in the close function. We do not need a traceback on every close in inet_tls_dist and this breaks using nodetool in control scripts on SSL clustered nodes --- lib/ssl/src/inet_tls_dist.erl | 5 ----- 1 file changed, 5 deletions(-) diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 57c859bf24..7367b5c224 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -95,11 +95,6 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> end. close(Socket) -> - try - erlang:error(foo) - catch _:_ -> - io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) - end, gen_tcp:close(Socket), ok. -- cgit v1.2.3 From d27003ba5c5ce962df439a99076a85607b82d746 Mon Sep 17 00:00:00 2001 From: Tristan Sloughter Date: Thu, 5 Sep 2013 17:43:05 -0500 Subject: fix private_key type documentation in ssh_server_key_api --- lib/ssh/doc/src/ssh_server_key_api.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index c4562e1211..51e1fc1f2e 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -29,7 +29,7 @@ -behaviour(ssh_server_key_api). -

Behaviour describing the API for an SSH server's public key handling.By implementing the callbacks defined +

Behaviour describing the API for an SSH server's public key handling. By implementing the callbacks defined in this behavior it is possible to customize the SSH server's public key handling. By default the SSH application implements this behavior with help of the standard openssh files, see ssh(6).

@@ -44,9 +44,9 @@

boolean() = true | false

string() = [byte()]

-

public_key() = #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()

-

private_key() = #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()

-

public_key_algorithm() = 'ssh-rsa'| 'ssh-dss' | atom()

+

public_key() = #'RSAPublicKey'{} | {integer(), #'Dss-Parms'{}} | term()

+

private_key() = #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()

+

public_key_algorithm() = 'ssh-rsa' | 'ssh-dss' | atom()

@@ -56,7 +56,7 @@ Fetches the hosts private key Algorithm = public_key_algorithm() - Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + Host key algorithm. Should support 'ssh-rsa' | 'ssh-dss' but additional algorithms can be handled. DaemonOptions = proplists:proplist() Options provided to ssh:daemon/[2,3] -- cgit v1.2.3 From 6cc7d88683f581fd6a1619aea8c3c5309f4f4013 Mon Sep 17 00:00:00 2001 From: Christopher Meiklejohn Date: Wed, 2 Oct 2013 16:26:19 -0500 Subject: Fix incorrect reporting of memory on OS X via memsup. Application memsup should be calculating free memory using the speculative pages, in the same manner that the Activity Monitor and top programs on OS X do. In addition, correct page size to 4096, based on verification of available memory between top, vm_stat and Activity Monitor. --- lib/os_mon/src/memsup.erl | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index a1b8591c8c..b178732fae 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -721,20 +721,19 @@ reply(Pending, MemUsage, SysMemUsage) -> %% get_memory_usage(OS) -> {Alloc, Total} %% Darwin: -%% Uses vm_stat command. This appears to lie about the page size in -%% Mac OS X 10.2.2 - the pages given are based on 4000 bytes, but -%% the vm_stat command tells us that it is 4096... +%% Uses vm_stat command. get_memory_usage({unix,darwin}) -> Str1 = os:cmd("/usr/bin/vm_stat"), - - {[Free], Str2} = fread_value("Pages free:~d.", Str1), - {[Active], Str3} = fread_value("Pages active:~d.", Str2), - {[Inactive], Str4} = fread_value("Pages inactive:~d.", Str3), - {[_], Str5} = fread_value("Pages speculative:~d.", Str4), + PageSize = 4096, + + {[Free], Str2} = fread_value("Pages free:~d.", Str1), + {[Active], Str3} = fread_value("Pages active:~d.", Str2), + {[Inactive], Str4} = fread_value("Pages inactive:~d.", Str3), + {[Speculative], Str5} = fread_value("Pages speculative:~d.", Str4), {[Wired], _} = fread_value("Pages wired down:~d.", Str5), - NMemUsed = (Wired + Active + Inactive) * 4000, - NMemTotal = NMemUsed + Free * 4000, + NMemUsed = (Wired + Active + Inactive) * PageSize, + NMemTotal = NMemUsed + (Free + Speculative) * PageSize, {NMemUsed,NMemTotal}; %% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct -- cgit v1.2.3 From 57abd27ee8e189791c4d97ef86de6136c4924b52 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 31 Oct 2013 17:03:02 +0100 Subject: [snmp] Improving ATL handling of corrupt logs When converting an Audit Trail Log to text a corrupt log entry could cause the entire conversion to fail. Also, for a log with sequence numbers, failing to decode a log entry would cause the conversion to fail (not because of the failed decode, but because of the failure to write the error message). OTP-11453 --- lib/snmp/doc/src/notes.xml | 62 ++++++++ lib/snmp/src/app/snmp.appup.src | 40 +++-- lib/snmp/src/misc/snmp_log.erl | 276 ++++++++++++++++++++++++++--------- lib/snmp/src/misc/snmp_verbosity.erl | 14 +- lib/snmp/vsn.mk | 2 +- 5 files changed, 309 insertions(+), 85 deletions(-) diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 8d280fb3a1..8320b8762e 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,6 +33,68 @@
+
+ SNMP Development Toolkit 4.22.3 +

Version 4.22.3 supports code replacement in runtime from/to + version 4.22.2, 4.22.1, 4.22, + 4.21.7 4.21.6 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1 and 4.21.

+ +
+ Improvements and new features +

-

+ + + +
+ +
+ Fixed Bugs and Malfunctions + + + + +

When converting an Audit Trail Log to text a corrupt + log entry could cause the entire conversion to fail.

+

Also, for a log with sequence numbers, failing to + decode a log entry would cause the conversion to fail + (not because of the failed decode, but because of the + failure to write the error message).

+

Own Id: OTP-111453

+

Aux Id: Seq 12459

+ + + + +
+ +
+ Incompatibilities +

-

+
+ +
+ +
SNMP Development Toolkit 4.22.2

Version 4.22.2 supports code replacement in runtime from/to diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 39e154d463..daf8496670 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,13 +22,24 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.22.2", + [ + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []} + ] + }, {"4.22.1", [ + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []} ] }, {"4.22", [ {load_module, snmpm, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, + [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmp_user_based_sm_mib, soft_purge, soft_purge, []} @@ -51,7 +62,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpa, soft_purge, soft_purge, [snmp]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -80,7 +91,7 @@ {load_module, snmpa, soft_purge, soft_purge, [snmp]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, {load_module, snmp_log, soft_purge, soft_purge, []}, - {load_module, snmp_verbosity, soft_purge, soft_purge, []}, + {load_module, snmp_verbosity, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, @@ -105,7 +116,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -137,7 +148,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -173,7 +184,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -209,7 +220,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -247,7 +258,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -286,7 +297,7 @@ {load_module, snmp, soft_purge, soft_purge, [snmp_log]}, {load_module, snmpm, soft_purge, soft_purge, [snmp]}, - {load_module, snmp_log, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmpm_mpd, soft_purge, soft_purge, []}, @@ -316,13 +327,24 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.22.2", + [ + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []} + ] + }, {"4.22.1", [ + {load_module, snmp_log, soft_purge, soft_purge, [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []} ] }, {"4.22", [ {load_module, snmpm, soft_purge, soft_purge, []}, + {load_module, snmp_log, soft_purge, soft_purge, + [snmp_verbosity]}, + {load_module, snmp_verbosity, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmp_user_based_sm_mib, soft_purge, soft_purge, []} diff --git a/lib/snmp/src/misc/snmp_log.erl b/lib/snmp/src/misc/snmp_log.erl index a8c5df0b64..a365e8c8ed 100644 --- a/lib/snmp/src/misc/snmp_log.erl +++ b/lib/snmp/src/misc/snmp_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -16,6 +16,7 @@ %% %% %CopyrightEnd% %% +%% -module(snmp_log). @@ -397,6 +398,8 @@ log_to_txt(Log, FileName, Dir, Mibs, TextFile, Start, Stop) [Log, FileName, Dir, Mibs, TextFile, Start, Stop]), File = filename:join(Dir, FileName), Converter = fun(L) -> + ?vtrace("log_to_txt:fun -> entry with" + "~n L: ~p", [L]), do_log_to_file(L, TextFile, Mibs, Start, Stop) end, log_convert(Log, File, Converter). @@ -422,6 +425,8 @@ log_to_io(Log, FileName, Dir, Mibs, Start, Stop) [Log, FileName, Dir, Mibs, Start, Stop]), File = filename:join(Dir, FileName), Converter = fun(L) -> + ?vtrace("log_to_io:fun -> entry with" + "~n L: ~p", [L]), do_log_to_io(L, Mibs, Start, Stop) end, log_convert(Log, File, Converter). @@ -439,22 +444,25 @@ log_convert(Log, File, Converter) -> do_log_convert(Log, File, Converter). do_log_convert(Log, File, Converter) -> - %% ?vtrace("do_log_converter -> entry with" - %% "~n Log: ~p" - %% "~n File: ~p" - %% "~n disk_log:info(Log): ~p", [Log, File, disk_log:info(Log)]), + ?vtrace("do_log_converter -> entry with" + "~n Log: ~p" + "~n File: ~p", [Log, File]), + Verbosity = get(verbosity), {Pid, Ref} = erlang:spawn_monitor( fun() -> + put(sname, "LOG-CONVERTER"), + put(verbosity, Verbosity), + erlang:process_flag(trap_exit, true), + ?vlog("begin converting", []), Result = do_log_convert2(Log, File, Converter), + ?vlog("convert result: ~p", [Result]), exit(Result) end), receive {'DOWN', Ref, process, Pid, Result} -> - %% ?vtrace("do_log_converter -> received result" - %% "~n Result: ~p" - %% "~n disk_log:info(Log): ~p", - %% [Result, disk_log:info(Log)]), + ?vtrace("do_log_converter -> received result" + "~n Result: ~p", [Result]), Result end. @@ -462,19 +470,31 @@ do_log_convert2(Log, File, Converter) -> %% First check if the caller process has already opened the %% log, because if we close an already open log we will cause %% a runtime error. + ?vtrace("do_log_convert2 -> entry - check if owner", []), case is_owner(Log) of true -> + ?vtrace("do_log_convert2 -> owner - now convert", []), Converter(Log); false -> %% Not yet member of the ruling party, apply for membership... + ?vtrace("do_log_convert2 -> not owner - open", []), case log_open(Log, File) of {ok, _} -> + ?vdebug("do_log_convert2 -> opened - now convert", []), Res = Converter(Log), + ?vtrace("do_log_convert2 -> converted - now close", []), disk_log:close(Log), + ?vtrace("do_log_convert2 -> closed - done", []), Res; {error, {name_already_open, _}} -> - Converter(Log); + ?vdebug("do_log_convert2 -> " + "already opened - now convert", []), + Res = Converter(Log), + ?vtrace("do_log_convert2 -> converted - done", []), + Res; {error, Reason} -> + ?vinfo("do_log_convert2 -> failed open: " + "~n Reason: ~p", [Reason]), {error, {Log, Reason}} end end. @@ -483,50 +503,93 @@ do_log_convert2(Log, File, Converter) -> %% -- do_log_to_text --- do_log_to_file(Log, TextFile, Mibs, Start, Stop) -> + ?vtrace("do_log_to_txt -> entry with" + "~n Log: ~p" + "~n TextFile: ~p" + "~n Start: ~p" + "~n Stop: ~p", [Log, TextFile, Start, Stop]), case file:open(TextFile, [write]) of {ok, Fd} -> + ?vtrace("do_log_to_txt -> outfile created - create mini MIB", []), MiniMib = snmp_mini_mib:create(Mibs), + ?vtrace("do_log_to_txt -> mini-MIB created - begin conversion", []), Write = fun(X) -> + ?vtrace("do_log_to_txt:fun -> " + "entry - try format", []), case format_msg(X, MiniMib, Start, Stop) of {ok, S} -> + ?vtrace("do_log_to_txt:fun -> " + "formated - now write", []), io:format(Fd, "~s", [S]); _ -> + ?vdebug("do_log_to_txt:fun -> " + "format failed", []), ok end end, Res = (catch loop(disk_log:chunk(Log, start), Log, Write)), + ?vtrace("do_log_to_txt -> converted - now delete mini-MIB", []), snmp_mini_mib:delete(MiniMib), + ?vtrace("do_log_to_txt -> " + "mini-MIB closed - now close output file", []), file:close(Fd), + ?vtrace("do_log_to_txt -> done", []), Res; {error, Reason} -> + ?vinfo("failed opening output file: " + "~n TestFile: ~p" + "~n Reason: ~p", [TextFile, Reason]), {error, {TextFile, Reason}} end. do_log_to_io(Log, Mibs, Start, Stop) -> + ?vtrace("do_log_to_io -> entry with" + "~n Log: ~p" + "~n Mibs: ~p" + "~n Start: ~p" + "~n Stop: ~p", [Log, Mibs, Start, Stop]), MiniMib = snmp_mini_mib:create(Mibs), + ?vtrace("do_log_to_io -> mini-MIB created - begin conversion", []), Write = fun(X) -> + ?vtrace("do_log_to_io:fun -> entry", []), case format_msg(X, MiniMib, Start, Stop) of {ok, S} -> + ?vtrace("do_log_to_io:fun -> " + "formated - now write", []), io:format("~s", [S]); _ -> + ?vdebug("do_log_to_io:fun -> " + "format failed", []), ok end end, (catch loop(disk_log:chunk(Log, start), Log, Write)), + ?vtrace("do_log_to_io -> converted - now delete mini-MIB", []), snmp_mini_mib:delete(MiniMib), + ?vtrace("do_log_to_io -> done", []), ok. loop(eof, _Log, _Write) -> + ?vtrace("loop -> entry when eof", []), ok; -loop({error, _} = Error, _Log, _Write) -> +loop({error, _Reason} = Error, _Log, _Write) -> + ?vtrace("loop -> entry with error" + "~n Reason: ~p", [_Reason]), Error; loop({Cont, Terms}, Log, Write) -> - case (catch lists:foreach(Write, Terms)) of + ?vtrace("loop -> entry with terms" + "~n Cont: ~p" + "~n length(Terms): ~p", [Cont, length(Terms)]), + case (catch lists:foreach(Write, Terms)) of {'EXIT', Reason} -> + ?vtrace("loop -> failure while writing terms" + "~n Reason: ~p", [Reason]), {error, Reason}; - _ -> + _X -> + ?vtrace("loop -> terms written" + "~n X: ~p", [_X]), loop(disk_log:chunk(Log, Cont), Log, Write) end; loop({Cont, Terms, BadBytes}, Log, Write) -> @@ -539,6 +602,8 @@ loop({Cont, Terms, BadBytes}, Log, Write) -> loop(disk_log:chunk(Log, Cont), Log, Write) end; loop(Error, _Log, _Write) -> + ?vtrace("loop -> entry with unknown" + "~n Error: ~p", [Error]), Error. @@ -553,14 +618,17 @@ format_msg(Entry, Mib, Start, Stop) -> %% This is an old-style entry, that never had the sequence-number do_format_msg({Timestamp, Packet, {Addr, Port}}, Mib) -> + ?vdebug("do_format_msg -> old style log entry", []), do_format_msg(Timestamp, Packet, Addr, Port, Mib); %% This is the format without sequence-number do_format_msg({Timestamp, Packet, Addr, Port}, Mib) -> + ?vdebug("do_format_msg -> log entry without seqno", []), do_format_msg(Timestamp, Packet, Addr, Port, Mib); %% This is the format with sequence-number do_format_msg({Timestamp, SeqNo, Packet, Addr, Port}, Mib) -> + ?vdebug("do_format_msg -> log entry with seqno", []), do_format_msg(Timestamp, SeqNo, Packet, Addr, Port, Mib); %% This is crap... @@ -568,103 +636,165 @@ do_format_msg(_, _) -> format_tab("** unknown entry in log file\n\n", []). do_format_msg(TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode scoped pdu", + [TimeStamp, Addr, Port]), case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> + ?vtrace("do_format_msg -> scoped pdu decoded" + "~n ScopedPDU: ~p", [ScopedPDU]), Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding scoped pdu: " + "~n V3Hdr: ~w" + "~n ScopedPdu: ~w" + "~n Reason: ~p", [V3Hdr, ScopedPdu, Reason]), + format_tab("** error in log file at ~s from ~s:~w ~p\n\n", [ts2str(TimeStamp), ip(Addr), Port, Reason]) end; + do_format_msg(TimeStamp, Packet, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode packet", + [TimeStamp, Addr, Port]), case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of - Msg when is_record(Msg, message) -> + #message{data = Data} = Msg when (is_record(Data, scopedPdu) orelse + is_record(Data, pdu) orelse + is_record(Data, trappdu)) -> + ?vtrace("do_format_msg -> packet decoded" + "~n Msg: ~p", [Msg]), f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + + #message{version = Vsn, + vsn_hdr = VsnHdr} = Msg -> + ?vinfo("Message not fully decoded: " + "~n Msg: ~p", [Msg]), + Reason = + lists:flatten( + io_lib:format("Message not fully decoded: " + "Vsn = ~p, VsnHdr = ~w", [Vsn, VsnHdr])), + format_tab("** error in log file ~s from ~s:~w => " + "\n ~s\n\n", + [ts2str(TimeStamp), ip(Addr), Port, Reason]); + {'EXIT', Reason} -> + ?vinfo("Failed decoding packet: " + "~n Packet: ~w" + "~n Reason: ~p", [Packet, Reason]), format_tab("** error in log file ~p\n\n", [Reason]) end. do_format_msg(TimeStamp, SeqNo, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n SeqNo: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode scoped pdu", + [TimeStamp, SeqNo, Addr, Port]), case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> + ?vtrace("do_format_msg -> scoped pdu decoded" + "~n ScopedPDU: ~p", [ScopedPDU]), Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding scoped pdu: " + "~n V3Hdr: ~w" + "~n ScopedPdu: ~w" + "~n Reason: ~p", [V3Hdr, ScopedPdu, Reason]), + format_tab("** error in log file at ~s~s from ~s:~w ~p\n\n", [ts2str(TimeStamp), sn2str(SeqNo), ip(Addr), Port, Reason]) end; do_format_msg(TimeStamp, SeqNo, Packet, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n SeqNo: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode message", + [TimeStamp, SeqNo, Addr, Port]), case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of - Msg when is_record(Msg, message) -> + #message{data = Data} = Msg when (is_record(Data, scopedPdu) orelse + is_record(Data, pdu) orelse + is_record(Data, trappdu)) -> + ?vtrace("do_format_msg -> message decoded" + "~n Msg: ~p", [Msg]), f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + + #message{version = Vsn, + vsn_hdr = VsnHdr} = Msg -> + ?vinfo("Message not fully decoded: " + "~n Msg: ~p", [Msg]), + Reason = + lists:flatten( + io_lib:format("Message not fully decoded: " + "Vsn = ~p, VsnHdr = ~w", [Vsn, VsnHdr])), + format_tab("** error in log file ~s~s from ~s:~w => " + "\n ~s\n\n", + [ts2str(TimeStamp), sn2str(SeqNo), + ip(Addr), Port, Reason]); + {'EXIT', Reason} -> - format_tab("** error in log file ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding packet: " + "~n Packet: ~w" + "~n Reason: ~p", [Packet, Reason]), + format_tab("** error in log file ~s (~s) from ~s:~w ~p\n\n", [ts2str(TimeStamp), sn2str(SeqNo), ip(Addr), Port, Reason]) end. -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, {Addr, Port}}, -%% Mib, Start, Stop) -> -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port}, -%% Mib, Start, Stop); -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port}, -%% Mib, Start, Stop) -> -%% case timestamp_filter(TimeStamp, Start, Stop) of -%% true -> -%% case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of -%% ScopedPDU when record(ScopedPDU, scopedPdu) -> -%% Msg = #message{version = 'version-3', -%% vsn_hdr = V3Hdr, -%% data = ScopedPDU}, -%% f(ts2str(TimeStamp), Msg, Addr, Port, Mib); -%% {'EXIT', Reason} -> -%% format_tab("** error in log file at ~s from ~p:~w ~p\n\n", -%% [ts2str(TimeStamp), ip(Addr), Port, Reason]) -%% end; -%% false -> -%% ignore -%% end; -%% format_msg({TimeStamp, Packet, {Addr, Port}}, Mib, Start, Stop) -> -%% format_msg({TimeStamp, Packet, Addr, Port}, Mib, Start, Stop); -%% format_msg({TimeStamp, Packet, Addr, Port}, Mib, Start, Stop) -> -%% case timestamp_filter(TimeStamp, Start, Stop) of -%% true -> -%% case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of -%% Msg when record(Msg, message) -> -%% f(ts2str(TimeStamp), Msg, Addr, Port, Mib); -%% {'EXIT', Reason} -> -%% format_tab("** error in log file ~p\n\n", [Reason]) -%% end; -%% false -> -%% ignore -%% end; -%% format_msg(_, _Mib, _Start, _Stop) -> -%% format_tab("** unknown entry in log file\n\n", []). - f(TimeStamp, SeqNo, #message{version = Vsn, vsn_hdr = VsnHdr, data = Data}, Addr, Port, Mib) -> - Str = format_pdu(Data, Mib), - HdrStr = format_header(Vsn, VsnHdr), - case get_type(Data) of - trappdu -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'snmpv2-trap' -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'inform-request' -> - f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'get-response' -> - f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - report -> - f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - _ -> - f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) + try + begin + Str = format_pdu(Data, Mib), + HdrStr = format_header(Vsn, VsnHdr), + case get_type(Data) of + trappdu -> + f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'snmpv2-trap' -> + f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'inform-request' -> + f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'get-response' -> + f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + report -> + f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + _ -> + f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) + end + end + catch + T:E -> + ?vinfo("Failed formating log entry" + "~n TimeStamp: ~p" + "~n SeqNo: ~p" + "~n Data: ~p" + "~n Vsn: ~p" + "~n VsnHdr: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n Error Type: ~w" + "~n Error: ~p", + [TimeStamp, SeqNo, Data, Vsn, VsnHdr, Addr, Port, T, E]), + format_tab("** error while formating log entry ~p\n\n", [{T, E}]) end. f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> @@ -691,7 +821,7 @@ f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> %% Convert a timestamp 2-tupple to a printable string %% ts2str({Local,Universal}) -> - dat2str(Local) ++ " , " ++ dat2str(Universal); + lists:flatten(dat2str(Local) ++ " , " ++ dat2str(Universal)); ts2str(_) -> "". @@ -788,7 +918,7 @@ get_type(#pdu{type = Type}) -> ip({A,B,C,D}) -> - io_lib:format("~w.~w.~w.~w", [A,B,C,D]). + lists:flatten(io_lib:format("~w.~w.~w.~w", [A,B,C,D])). diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index df5986b7bc..8c4fe3fcb0 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -152,7 +152,17 @@ image_of_sname(mgr) -> "MGR"; image_of_sname(mgr_misc) -> "MGR_MISC"; image_of_sname(undefined) -> ""; -image_of_sname(V) -> lists:flatten(io_lib:format("~p",[V])). +image_of_sname(S) when is_list(S) -> + %% The assumption is that its a printable string, + %% but just in case it is some other list... + try lists:flatten(io_lib:format("~s", [S])) of + L -> + L + catch + _:_ -> + lists:flatten(io_lib:format("~p", [S])) + end; +image_of_sname(V) -> lists:flatten(io_lib:format("~p", [V])). validate(info) -> info; diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 5d3c393bcc..8a4d9c14c0 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.22.2 +SNMP_VSN = 4.22.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" -- cgit v1.2.3 From 70ebf76f1cef4a6de6be3ea96b36fb81fe245921 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 28 Oct 2013 18:26:40 +0100 Subject: erts: Add max alignment posix_memalign configure check On some OSs posix_memalign exists, but it does not allow for alignment greater than the current page size. So we have to do a runtime check for alignment size and also add cross compile options. --- HOWTO/INSTALL-CROSS.md | 5 +++++ erts/configure.in | 30 +++++++++++++++++++++++++++++- xcomp/erl-xcomp-vars.sh | 2 +- xcomp/erl-xcomp.conf.template | 6 ++++++ 4 files changed, 41 insertions(+), 2 deletions(-) diff --git a/HOWTO/INSTALL-CROSS.md b/HOWTO/INSTALL-CROSS.md index a5cf775583..03ea4c6e76 100644 --- a/HOWTO/INSTALL-CROSS.md +++ b/HOWTO/INSTALL-CROSS.md @@ -515,6 +515,11 @@ When a variable has been set, no warning will be issued. * `erl_xcomp_reliable_fpe` - `yes|no`. Defaults to `no`. If `yes`, the target system must have reliable floating point exceptions. +* `erl_xcomp_posix_memalign` - `yes|no`. Defaults to `yes` if `posix_memalign` + system call exists; otherwise `no`. If `yes`, the target system must have a + `posix_memalign` implementation that accepts larger than page size + alignment. + Copyright and License --------------------- diff --git a/erts/configure.in b/erts/configure.in index f17f4cb5c8..8288a1aab1 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1974,11 +1974,39 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ pread pwrite memmove strerror strerror_r strncasecmp \ - gethrtime localtime_r gmtime_r inet_pton posix_memalign \ + gethrtime localtime_r gmtime_r inet_pton \ mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll]) + +case X$erl_xcomp_posix_memalign in + Xno) ;; + Xyes) AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], + [Define to 1 if you have the `posix_memalign' function.]) ;; + *) + AC_CHECK_FUNC( + [posix_memalign], + [if test "$cross_compiling" != yes; then +AC_TRY_RUN([ +#include +int main(void) { + void *ptr = NULL; + int error; + size_t alignment = 0x40000, size = 0x20028; + if ((error = posix_memalign(&ptr, alignment, size)) != 0 || ptr == NULL) + return error; + return 0; +} +],AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], + [Define to 1 if you have the `posix_memalign' function.]) +) + else + AC_DEFINE(HAVE_POSIX_MEMALIGN,[1], + [Define to 1 if you have the `posix_memalign' function.]) + fi]);; +esac + dnl writev on OS X snow leopard is broken for files > 4GB case $host_os in darwin10.8.0) diff --git a/xcomp/erl-xcomp-vars.sh b/xcomp/erl-xcomp-vars.sh index eccdff47e3..337e0fb809 100644 --- a/xcomp/erl-xcomp-vars.sh +++ b/xcomp/erl-xcomp-vars.sh @@ -26,4 +26,4 @@ # and precious variables in $ERL_TOP/erts/aclocal.m4. # -erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers" +erl_xcomp_vars="erl_xcomp_sysroot erl_xcomp_isysroot erl_xcomp_bigendian erl_xcomp_double_middle_endian erl_xcomp_linux_clock_gettime_correction erl_xcomp_linux_nptl erl_xcomp_linux_usable_sigusrx erl_xcomp_linux_usable_sigaltstack erl_xcomp_poll erl_xcomp_kqueue erl_xcomp_putenv_copy erl_xcomp_reliable_fpe erl_xcomp_getaddrinfo erl_xcomp_gethrvtime_procfs_ioctl erl_xcomp_clock_gettime_cpu_time erl_xcomp_after_morecore_hook erl_xcomp_dlsym_brk_wrappers erl_xcomp_posix_memalign" diff --git a/xcomp/erl-xcomp.conf.template b/xcomp/erl-xcomp.conf.template index 7d70332cef..ad72b7d66b 100644 --- a/xcomp/erl-xcomp.conf.template +++ b/xcomp/erl-xcomp.conf.template @@ -264,4 +264,10 @@ # system must have reliable floating point exceptions. #erl_xcomp_reliable_fpe= +# * `erl_xcomp_posix_memalign' - `yes|no'. Defaults to `yes' if `posix_memalign' +# system call exists; otherwise `no'. If `yes', the target system must have a +# `posix_memalign' implementation that accepts larger than page size +# alignment. +#erl_xcomp_posix_memalign= + ## ----------------------------------------------------------------------------- -- cgit v1.2.3 From 1fd424859cfaebd371a08ab5977623dd20d28067 Mon Sep 17 00:00:00 2001 From: Julien Barbot Date: Thu, 31 Oct 2013 17:33:13 +0100 Subject: Fix client_preferred_next_protocols documentation --- lib/ssl/doc/src/ssl.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 6029a09730..445a47c07b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -86,7 +86,7 @@ {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} {next_protocols_advertised, [binary()]} | - {client_preferred_next_protocols, client | server, [binary()]} | + {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}} | {log_alert, boolean()}

@@ -353,8 +353,8 @@ fun(srp, Username :: string(), UserState :: term()) -> when possible. - {client_preferred_next_protocols, Precedence :: server | client, ClientPrefs :: [binary()]} - {client_preferred_next_protocols, Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()} + {client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}} + {client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}

Indicates the client will try to perform Next Protocol Negotiation.

-- cgit v1.2.3 From b179331cfb49ce67cda3e66c91f42fd29ed50116 Mon Sep 17 00:00:00 2001 From: Leo Correa Date: Fri, 4 Oct 2013 16:40:09 -0400 Subject: Typo fix ambigous -> ambiguous --- lib/compiler/src/beam_validator.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 70279ab658..48f5135aca 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -530,7 +530,7 @@ valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> %% Update branched state valfun_3(I, branch_state(Fail, Vst)); valfun_2(_, _) -> - error(ambigous_catch_try_state). + error(ambiguous_catch_try_state). %% Handle the remaining floating point instructions here. %% Floating point. -- cgit v1.2.3 From c03b279ca0888926b88e28f8c7edf4a76454b4a3 Mon Sep 17 00:00:00 2001 From: Fredrik Gustafsson Date: Fri, 1 Nov 2013 15:33:52 +0100 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 34556 -> 34556 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index 6b8673cb82..b8a3491caa 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ -- cgit v1.2.3 From 83ba8e6a9cc704bb3713b0a8f4e8c8a71b6dea0a Mon Sep 17 00:00:00 2001 From: Daniel White Date: Fri, 13 Sep 2013 00:54:29 +1000 Subject: xmerl: Add tests for XPath queries that resolve the context namespace Ensures that both the original namespace prefix and a namespace prefix provided to the xmlContext will both return the same sets of nodes. --- lib/xmerl/test/xmerl_SUITE.erl | 7 ++++- .../test/xmerl_SUITE_data/xpath/purchaseOrder.xml | 5 ++-- .../test/xmerl_SUITE_data/xpath/xpath_abbrev.erl | 31 ++++++++++++++++++++++ 3 files changed, 40 insertions(+), 3 deletions(-) diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index e21355f877..8432e66a97 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -42,7 +42,7 @@ %%---------------------------------------------------------------------- all() -> [{group, cpd_tests}, xpath_text1, xpath_main, - xpath_abbreviated_syntax, xpath_functions, + xpath_abbreviated_syntax, xpath_functions, xpath_namespaces, {group, misc}, {group, eventp_tests}, {group, ticket_tests}, {group, app_test}, {group, appup_test}]. @@ -205,6 +205,11 @@ xpath_functions(Config) -> ?line file:set_cwd(filename:join(?config(data_dir,Config),xpath)), ?line ok = xpath_abbrev:functions(). +xpath_namespaces(suite) -> []; +xpath_namespaces(Config) -> + ?line file:set_cwd(filename:join(?config(data_dir,Config),xpath)), + ?line ok = xpath_abbrev:namespaces(). + %%---------------------------------------------------------------------- latin1_alias(suite) -> []; diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml b/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml index a5ae223d65..16090c3590 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml @@ -1,7 +1,8 @@ - + Robert Smith 8 Oak Avenue @@ -10,7 +11,7 @@ 95819 Hurry, my lawn is going wild! - + Alice Smith 123 Maple Street diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index 7b6f1e95b3..afd39b6598 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -8,6 +8,7 @@ -module(xpath_abbrev). -export([test/0, check_node_set/2, ticket_6873/0, ticket_7496/0, functions/0]). +-export([namespaces/0]). -include("test_server.hrl"). -include_lib("xmerl/include/xmerl.hrl"). @@ -264,3 +265,33 @@ functions() -> [city,city,comment]), ?line ok = Test(Doc2,"//*[starts-with(name(),'{http://www.example.com/PO1')]", ['apo:purchaseOrder','apo:comment']). + + +namespaces() -> + {Doc,_} = xmerl_scan:file("purchaseOrder.xml", [{namespace_conformant, true}]), + + %% Element name using regular namespace and context namespace declaration. + ?line [#xmlElement{nsinfo = {_, "purchaseOrder"}}] = + xmerl_xpath:string("/apo:purchaseOrder", Doc), + ?line [#xmlElement{nsinfo = {_, "purchaseOrder"}}] = + xmerl_xpath:string("/t:purchaseOrder", Doc, [{namespace, [{"t", "http://www.example.com/PO1"}]}]), + + %% Wildcard element name using regular namespace and context namespace declaration. + ?line [#xmlElement{nsinfo = {_, "comment"}}] = + xmerl_xpath:string("./apo:*", Doc), + ?line [#xmlElement{nsinfo = {_, "comment"}}] = + xmerl_xpath:string("./t:*", Doc, [{namespace, [{"t", "http://www.example.com/PO1"}]}]), + + %% Attribute name using regular namespace and context namespace declaration. + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@xsi:type", Doc), + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@t:type", Doc, [{namespace, [{"t", "http://www.w3.org/2001/XMLSchema-instance"}]}]), + + %% Wildcard attribute name using regular namespace and context namespace declaration. + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@xsi:*", Doc), + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@t:*", Doc, [{namespace, [{"t", "http://www.w3.org/2001/XMLSchema-instance"}]}]), + + ok. -- cgit v1.2.3 From f041ece67a75593c39d36c3ef968556214e2b126 Mon Sep 17 00:00:00 2001 From: Daniel White Date: Thu, 12 Sep 2013 23:55:48 +1000 Subject: xmerl: Look up unknown prefixes in xmlContext when matching attributes The core use case is a query where the original prefix in the scanned document is unknown (or varying). For example: xmerl_xpath:scan("//@ns:name", Doc, [{namespace, [{"ns", Uri}]}]) Previously, this would only return a result if the namespace prefix was an exact match. --- lib/xmerl/src/xmerl_xpath.erl | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index b3301f2faf..9af632e9ac 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -760,20 +760,21 @@ node_test({name, {_Tag, Prefix, Local}}, node_test({name, {Tag,_Prefix,_Local}}, #xmlNode{node = #xmlAttribute{name = Tag}}, _Context) -> true; -node_test({name, {_Tag, Prefix, Local}}, - #xmlNode{node = #xmlAttribute{expanded_name = {URI, Local}, - nsinfo = {_Prefix1, _}, - namespace = NS}}, _Context) -> - NSNodes = NS#xmlNamespace.nodes, - case lists:keysearch(Prefix, 1, NSNodes) of - {value, {_, URI}} -> - ?dbg("node_test(~, ~p) -> true.~n", - [{_Tag, Prefix, Local}, write_node(NSNodes)]), - true; - false -> - ?dbg("node_test(~, ~p) -> false.~n", - [{_Tag, Prefix, Local}, write_node(NSNodes)]), - false +node_test({name, {Tag, Prefix, Local}}, + #xmlNode{node = #xmlAttribute{name = Name, + expanded_name = EExpName + }}, Context) -> + case expanded_name(Prefix, Local, Context) of + [] -> + Res = (Tag == Name), + ?dbg("node_test(~p, ~p) -> ~p.~n", + [{Tag, Prefix, Local}, write_node(Name), Res]), + Res; + ExpName -> + Res = (ExpName == EExpName), + ?dbg("node_test(~p, ~p) -> ~p.~n", + [{Tag, Prefix, Local}, write_node(Name), Res]), + Res end; node_test({name, {_Tag, [], Local}}, #xmlNode{node = #xmlNsNode{prefix = Local}}, _Context) -> -- cgit v1.2.3 From 3702a386fd0121bde1b1d02c65de66245e9518cc Mon Sep 17 00:00:00 2001 From: Daniel White Date: Fri, 13 Sep 2013 00:22:47 +1000 Subject: xmerl: Use context namespace declarations to resolve prefix node tests Previously, a match would not be found if the namespace prefix in the XPath query was not contained in the original document. This allows the `namespace' option to provide a prefix that will be resolved to a namespace URI. See Section 2.3 of the XPath 1.0 specification for the behaviour of 'NCName:*' node tests. --- lib/xmerl/src/xmerl_xpath.erl | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index 9af632e9ac..be0e863ce4 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -713,10 +713,26 @@ node_test(_Test, node_test({wildcard, _}, #xmlNode{type=ElAt}, _Context) when ElAt==element; ElAt==attribute; ElAt==namespace -> true; -node_test({prefix_test, Prefix}, #xmlNode{node = N}, _Context) -> +node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) -> case N of - #xmlElement{nsinfo = {Prefix, _}} -> true; - #xmlAttribute{nsinfo = {Prefix, _}} -> true; + #xmlElement{nsinfo = {Prefix, _}} -> + true; + #xmlElement{expanded_name = {Uri, _}} -> + case expanded_name(Prefix, "_", Context) of + {Uri, _} -> + true; + _ -> + false + end; + #xmlAttribute{nsinfo = {Prefix, _}} -> + true; + #xmlAttribute{expanded_name = {Uri, _}} -> + case expanded_name(Prefix, "_", Context) of + {Uri, _} -> + true; + _ -> + false + end; _ -> false end; -- cgit v1.2.3 From d64c016b8453ac143a6c26493a0fb1908f34ed99 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Fri, 27 Sep 2013 11:07:32 +0200 Subject: Avoid serialization on code_server in xmerl:export() The inheritance mechanism in xmerl used to use 'catch apply(M,F,Args)' to try different modules M until one was found that had a function F/A. However, when M:F/A does not exist, apply/3 will trap to error_handler:undefined_function/3, which will call code:ensure_loaded(M), making a synchronous request to the code server process. If many processes tried to use xmerl:export() concurrently, they would get serialized waiting for the code server process. This patch uses erlang:function_exported/3 instead to check if M:F/A exists. If M exists, it should already have been loaded at that point due to the inheritance checking in the xmerl:callbacks/1 function. --- lib/xmerl/src/xmerl.erl | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 3249094e78..01af183eef 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -303,18 +303,17 @@ apply_tag_cb(Ms, F, Args) -> apply_cb(Ms, F, '#element#', Args). apply_cb(Ms, F, Df, Args) -> - apply_cb(Ms, F, Df, Args, Ms). - -apply_cb([M|Ms], F, Df, Args, Ms0) -> - case catch apply(M, F, Args) of - {'EXIT', {undef,[{M,F,_,_}|_]}} -> - apply_cb(Ms, F, Df, Args, Ms0); - {'EXIT', Reason} -> - exit(Reason); - Res -> - Res + apply_cb(Ms, F, Df, Args, length(Args)). + +apply_cb(Ms, F, Df, Args, A) -> + apply_cb(Ms, F, Df, Args, A, Ms). + +apply_cb([M|Ms], F, Df, Args, A, Ms0) -> + case erlang:function_exported(M, F, A) of + true -> apply(M, F, Args); + false -> apply_cb(Ms, F, Df, Args, A, Ms0) end; -apply_cb([], Df, Df, Args, _Ms0) -> +apply_cb([], Df, Df, Args, A, _Ms0) -> exit({unknown_tag, {Df, Args}}); -apply_cb([], F, Df, Args, Ms0) -> - apply_cb(Ms0, Df, Df, [F|Args]). +apply_cb([], F, Df, Args, A, Ms0) -> + apply_cb(Ms0, Df, Df, [F|Args], A+1). -- cgit v1.2.3