diff options
Diffstat (limited to 'lib/stdlib/src')
-rw-r--r-- | lib/stdlib/src/dets.erl | 108 | ||||
-rw-r--r-- | lib/stdlib/src/dets.hrl | 3 | ||||
-rw-r--r-- | lib/stdlib/src/dets_v8.erl | 16 | ||||
-rw-r--r-- | lib/stdlib/src/dets_v9.erl | 118 | ||||
-rw-r--r-- | lib/stdlib/src/epp.erl | 28 | ||||
-rw-r--r-- | lib/stdlib/src/erl_eval.erl | 3 | ||||
-rw-r--r-- | lib/stdlib/src/erl_lint.erl | 9 | ||||
-rw-r--r-- | lib/stdlib/src/erl_parse.yrl | 12 | ||||
-rw-r--r-- | lib/stdlib/src/erl_pp.erl | 10 | ||||
-rw-r--r-- | lib/stdlib/src/lists.erl | 29 | ||||
-rw-r--r-- | lib/stdlib/src/ms_transform.erl | 17 | ||||
-rw-r--r-- | lib/stdlib/src/qlc.erl | 5 | ||||
-rw-r--r-- | lib/stdlib/src/random.erl | 42 | ||||
-rw-r--r-- | lib/stdlib/src/supervisor.erl | 123 |
14 files changed, 352 insertions, 171 deletions
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index fa0641ffd9..c0f9ce34b0 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %%% Internal functions %%%---------------------------------------------------------------------- -constants(FH, FileName) -> - Version = FH#fileheader.version, - if - Version =< 8 -> - dets_v8:constants(); - Version =:= 9 -> - dets_v9:constants(); - true -> - throw({error, {not_a_dets_file, FileName}}) - end. - %% -> {ok, Fd, fileheader()} | throw(Error) read_file_header(FileName, Access, RamFile) -> BF = if @@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) -> {H2, {error, old_version}}; Parms -> L = dets_utils:all_allocated(H2), - C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L}, + Bin = if + L =:= <<>> -> eof; + true -> <<>> + end, + C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, [BinParms]}} @@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) -> %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {error, not_closed} -> - io:format(user,"dets: file ~p not properly closed, " - "repairing ...~n", [Fname]), + Do = case Mod:check_file_header(FH, Fd) of + {ok, Head1, ExtraInfo} -> + Head2 = Head1#head{filename = Fname}, + try {ok, Mod:init_freelist(Head2, ExtraInfo)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + {error, not_closed} -> + M = " not properly closed, repairing ...", + {repair, M}; + Else -> + Else + end, + case Do of + {repair, Mess} -> + io:format(user, "dets: file ~p~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) -> Error -> throw(Error) end; - {ok, Head, ExtraInfo} -> + {ok, Head} -> open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE, - Tab, ExtraInfo, false); + Tab, false); {error, Reason} -> throw({error, {Reason, Fname}}) end; @@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) -> V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of + Mod = (FH#fileheader.mod), + Wh = case Mod:check_file_header(FH, Fd) of {ok, Head, true} when Rep =:= force, Acc =:= read_write, FH#fileheader.version =:= 9, FH#fileheader.no_colls =/= undefined, MinF, MaxF, V9 -> - {compact, Head}; + {compact, Head, true}; {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); {ok, Head, need_compacting} when Acc =:= read -> @@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) -> {error, Reason} -> throw({error, {Reason, Fname}}) end, + Do = case Wh of + {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + Hd1 = Hd#head{filename = Fname}, + try {Tag, Mod:init_freelist(Hd1, Extra)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + Else -> + Else + end, case Do of _ when FH#fileheader.type =/= Type -> throw({error, {type_mismatch, Fname}}); @@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) -> {compact, SourceHead} -> io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, - ?DEFAULT_CACHE, Tab, true, - Debug), + ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of ok -> erlang:garbage_collect(), @@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) -> Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> throw({error, {version_mismatch, Fname}}); - {final, H, EI} -> + {final, H} -> H1 = H#head{auto_save = Auto}, - open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug) + open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> @@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> end. %% -> {ok, head()} | throw(Error) -open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) -> +open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> Head1 = Head#head{access = Acc, ram_file = Ram, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, init_disk_map(Head1#head.version, Tab, Debug), - Mod = Head#head.mod, - Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next), - Ftab = Mod:init_freelist(Head1, ExtraInfo), + (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), - NewHead = Head1#head{freelists = Ftab}, - {ok, NewHead}. + {ok, Head1}. %% -> {ok, head()} | throw(Error) fopen_init_file(Tab, OpenArgs) -> @@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) -> check_safe_fixtable(Head), FreeLists = dets_utils:get_freelists(Head), Base = Head#head.base, - {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base), - #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}. + case dets_utils:find_next_allocated(FreeLists, Base, Base) of + {From, To} -> + #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}}; + none -> + #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>} + end. check_safe_fixtable(Head) -> case (Head#head.fixed =:= false) andalso @@ -3241,18 +3259,20 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - file:close(Fd); - X -> - file:close(Fd), - X - end; + try Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Mod = FH#fileheader.mod, + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + H = Mod:init_freelist(H0, ExtraInfo), + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end + after file:close(Fd) + end; X -> X end. diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index fbffc9d008..a3f99357a2 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -92,6 +92,7 @@ %% Info extracted from the file header. -record(fileheader, { freelist, + fl_base, cookie, closed_properly, type, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index cdd38d5604..3e962a1c8b 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles versions up to %% and including 8(c). To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, write_cache/1, may_grow/3, @@ -196,10 +196,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - FreeList = lists:reverse(Term), - dets_utils:init_slots_from_old_file(FreeList, Ftab); + FreeList1 = lists:reverse(Term), + FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), + Head#head{freelists = FreeList, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end; @@ -318,7 +315,7 @@ init_freelist(Head, _) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - Term; + Head#head{freelists = Term, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end. @@ -331,6 +328,7 @@ read_file_header(Fd, FileName) -> {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), FH = #fileheader{freelist = Freelist, + fl_base = ?BASE, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -413,7 +411,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 132af01f79..f577b4410f 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles version 9. %% To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, prep_table_copy/9, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, bchunk_init/2, @@ -70,6 +70,17 @@ %% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. %% (FreelistsPointer, Cookie and ClosedProperly are not digested.) %% 128 Reserved for future versions. Initially zeros. +%% Version 9(d), introduced in R15A, has instead: +%% 112 28 counters for the buddy system sizes (as for 9(b)). +%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. +%% (FreelistsPointer, Cookie and ClosedProperly are not digested.) +%% 4 Base of the buddy system. +%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B. +%% File size at the end of the file is RealFileSize - Base. +%% The reason for modifying file size is that when a file created +%% by R15 is read by R14 a repair takes place immediately, which +%% is acceptable when downgrading. +%% 124 Reserved for future versions. Initially zeros. %% --- %% ------------------ end of file header %% 4*256 SegmentArray Pointers. @@ -86,7 +97,7 @@ %% ----------------------------- %% ??? Free lists %% ----------------------------- -%% 4 File size, in bytes. +%% 4 File size, in bytes. See 9(d) obove. %% Before we can find an object we must find the slot where the %% object resides. Each slot is a (possibly empty) list (or chain) of @@ -177,14 +188,14 @@ %%% File header %%% --define(RESERVED, 128). % Reserved for future use. +-define(RESERVED, 124). % Reserved for future use. -define(COLL_CNTRS, (28*4)). % Counters for the buddy system. -define(MD5SZ, 16). +-define(FL_BASE, 4). --define(HEADSZ, - 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes, - % not including the reserved part. +-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes, + +?MD5SZ+?FL_BASE). % not including the reserved part. -define(HEADEND, (?HEADSZ+?RESERVED)). % End of header and reserved area. -define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP. @@ -270,10 +281,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, cache = dets_utils:new_cache(CacheSz), version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, + base = ?BASE, % to be overwritten mod = ?MODULE }, @@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, {Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []), NoSegs = no_segs(Next), - {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), + {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), Ws2 = if DoInitSegments -> WsP ++ WsI; true -> WsP end, dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]), - true = hash_invars(Head), + true = hash_invars(Head2), + %% The allocations that have been made so far (parts, segments) + %% are permanent; the table will never shrink. Therefore the base + %% of the Buddy system can be set to the first free object. + %% This is used in allocate_all(), see below. + {_, Where, _} = dets_utils:alloc(Head2, ?BUMP), + NewFtab = dets_utils:init_alloc(Where), + Head = Head2#head{freelists = NewFtab, base = Where}, {ok, Head}. %% Returns a power of two not less than 256. @@ -451,8 +465,9 @@ read_file_header(Fd, FileName) -> Version:32, M:32, Next:32, Kp:32, NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32, HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary, - MD5:?MD5SZ/binary>> = Bin, - <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin, + MD5:?MD5SZ/binary, FlBase:32>> = Bin, + <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary, + _/binary>> = Bin, {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), {CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) -> @@ -468,8 +483,12 @@ read_file_header(Fd, FileName) -> true -> lists:reverse(CL) end, - + Base = case FlBase of + 0 -> ?BASE; + _ -> FlBase + end, FH = #fileheader{freelist = FreeList, + fl_base = Base, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -486,7 +505,7 @@ read_file_header(Fd, FileName) -> read_md5 = MD5, has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5, md5 = erlang:md5(MD5DigestedPart), - trailer = FileSize, + trailer = FileSize + FlBase, eof = EOF, n = N, mod = ?MODULE}, @@ -544,7 +563,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error @@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) -> write_loop(Head, BytesToWrite, SmallBin). %% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) +%% buddy system memory map are avoided. allocate_all_objects(Head, SizeT) -> DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))), MaxSz = element(1, hd(DTL)), - SegSize = ?ACTUAL_SEG_SIZE, - {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize), - {Head2, NL} = allocate_all(Head1, DTL, []), + {Head1, NL} = allocate_all(Head, DTL, []), %% Find the position that will be the end of the file by allocating %% a minimal object. - {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP), - Head3 = free_hole(Head2, HSz, HN, HA), - NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)}, + {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP), + NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)}, {NewHead, NL, MaxSz, EndOfFile}. -alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz -> - Size = ?POW(LSize-1), - {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)), - {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz, N, SegAddr}; -alloc_hole(_MaxSz, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)), - free_hole(Head1, Size, N-1, Addr+Size). - %% One (temporary) file for each buddy size, write all objects of that %% size to the file. +%% +%% Before R15 a "hole" was needed before the first bucket if the size +%% of the biggest bucket was greater than the size of a segment. The +%% hole proved to be a problem with almost full tables with huge +%% buckets. Since R15 the hole is no longer needed due to the fact +%% that the base of the Buddy system is flexible. allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) -> %% And one file for the segments... %% Note that space for the array parts and the segments has @@ -1593,23 +1596,28 @@ do_perform_save(H) -> H1 = H#head{freelists_p = FreeListsPointer}, {FLW, FLSize} = free_lists_to_file(H1), FileSize = FreeListsPointer + FLSize + 4, - ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]), + AdjustedFileSize = case H#head.base of + ?BASE -> FileSize; + Base -> FileSize - Base + end, + ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]), FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead = H1#head{freelists = init_freelist(H1, true), - fixed = false}, + TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) =:= dets_utils:all_allocated_as_list(H1) - of + of true -> dets_utils:pwrite(H1, [{0, FileHeader}]); _ -> + throw( dets_utils:corrupt_reason(H1, {failed_to_save_free_lists, FreeListsPointer, TmpHead#head.freelists, - H1#head.freelists}) + H1#head.freelists})) end; false -> dets_utils:pwrite(H1, [{0, FileHeader}]) @@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) -> true -> erlang:md5(DigH); false -> <<0:?MD5SZ/unit:8>> end, - [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>]. + Base = case Head#head.base of + ?BASE -> <<0:32>>; + FlBase -> <<FlBase:32>> + end, + [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>]. %% Going through some trouble to avoid creating one single binary for %% the free lists. If the free lists are huge, binary_to_term and @@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) -> case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> throw({error, {bad_freelists, H#head.filename}}); - Reply -> - Reply + Ftab -> + H#head{freelists = Ftab, base = ?BASE} end. bin_to_tree(Bin, H, LastPos, Ftab, A0, L) -> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 230a4a0612..ccc14610d7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -267,8 +267,10 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> case user_predef(Pdm, Ms0) of {ok,Ms1} -> epp_reply(Pid, {ok,self()}), + %% ensure directory of current source file is first in path + Path1 = [filename:dirname(Name) | Path], St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path, macs=Ms1, pre_opened = Pre}, + name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -360,18 +362,18 @@ wait_req_skip(St, Sis) -> From = wait_request(St), skip_toks(From, St, Sis). -%% enter_file(Path, FileName, IncludeToken, From, EppState) +%% enter_file(FileName, IncludeToken, From, EppState) %% leave_file(From, EppState) %% Handle entering and leaving included files. Notify caller when the %% current file is changed. Note it is an error to exit a file if we are %% in a conditional. These functions never return. -enter_file(_Path, _NewName, Inc, From, St) +enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); -enter_file(Path, NewName, Inc, From, St) -> - case file:path_open(Path, NewName, [read]) of +enter_file(NewName, Inc, From, St) -> + case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); @@ -384,13 +386,16 @@ enter_file(Path, NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St, AtLocation) -> - enter_file2(NewF, Pname, From, St, AtLocation, []). - -enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) -> Loc = start_loc(AtLocation), enter_file_reply(From, Pname, Loc, AtLocation), Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), - Path = St#epp.path ++ ExtraPath, + %% update the head of the include path to be the directory of the new + %% source file, so that an included file can always include other files + %% relative to its current location (this is also how C does it); note + %% that the directory of the parent source file (the previous head of + %% the path) must be dropped, otherwise the path used within the current + %% file will depend on the order of file inclusions in the parent files + Path = [filename:dirname(Pname) | tl(St#epp.path)], #epp{file=NewF,location=Loc,name=Pname,delta=0, sstk=[St|St#epp.sstk],path=Path,macs=Ms}. @@ -655,7 +660,7 @@ scan_undef(_Toks, Undef, From, St) -> scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> NewName = expand_var(NewName0), - enter_file(St#epp.path, NewName, Inc, From, St); + enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -687,9 +692,8 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> - ExtraPath = [filename:dirname(LibName)], wait_req_scan(enter_file2(NewF, LibName, From, - St, Loc, ExtraPath)); + St, Loc)); {error,_E2} -> epp_reply(From, {error,{abs_loc(Inc),epp, diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 4f4fa16040..88a0094d57 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 78b996d94b..5d45260fe9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2127,8 +2127,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 709bd83e6f..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -395,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index bba46e4cb6..e73c087753 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -628,9 +628,10 @@ keydelete3(_, _, []) -> []. -spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + NewTuple :: Tuple, + Tuple :: tuple(). keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keyreplace3(K, N, L, New). @@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false. -spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple(), ...], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple, ...], + NewTuple :: Tuple, + Tuple :: tuple(). keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keystore2(K, N, L, New). @@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). keymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> case L2 of @@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 -> case L1 of @@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> -spec keymap(Fun, N, TupleList1) -> TupleList2 when Fun :: fun((Term1 :: term()) -> Term2 :: term()), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()]. + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + Tuple :: tuple(). keymap(Fun, Index, [Tup|Tail]) -> [setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)]; diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 48e22e53fa..63b397f3a5 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -333,17 +333,18 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - {Clauses1,_} = clauses(Clauses0,gb_sets:new()), + Clauses1 = clauses(Clauses0), {Name,Arity,Clauses1}. -clauses([C0|Cs],Bound) -> - {C1,Bound1} = clause(C0,Bound), - {C2,Bound2} = clauses(Cs,Bound1), - {[C1|C2],Bound2}; -clauses([],Bound) -> {[],Bound}. +clauses([C0|Cs]) -> + C1 = clause(C0,gb_sets:new()), + C2 = clauses(Cs), + [C1|C2]; +clauses([]) -> []. + clause({clause,Line,H0,G0,B0},Bound) -> {H1,Bound1} = copy(H0,Bound), - {B1,Bound2} = copy(B0,Bound1), - {{clause,Line,H1,G0,B1},Bound2}. + {B1,_Bound2} = copy(B0,Bound1), + {clause,Line,H1,G0,B1}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, As0},Bound) -> diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f5e180b4bd..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index dbb524cc74..d7b51a151c 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -26,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -66,17 +74,15 @@ seed({A1, A2, A3}) -> A3 :: integer(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -88,11 +94,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 -> State1 :: ran(). uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 9da0d52f8c..f20ea18fd0 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -515,9 +515,12 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> + terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, + State#state.dynamics), + State#state.name); terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. + terminate_children(State#state.children, State#state.name). %% %% Change code for the supervisor. @@ -830,8 +833,109 @@ monitor_child(Pid) -> %% that will be handled in shutdown/2. ok end. - - + + +%%----------------------------------------------------------------- +%% Func: terminate_dynamic_children/3 +%% Args: Child = child_rec() +%% Dynamics = ?DICT() | ?SET() +%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Returns: ok +%% +%% +%% Shutdown all dynamic children. This happens when the supervisor is +%% stopped. Because the supervisor can have millions of dynamic children, we +%% can have an significative overhead here. +%%----------------------------------------------------------------- +terminate_dynamic_children(Child, Dynamics, SupName) -> + {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), + Sz = ?SETS:size(Pids), + EStack = case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) + end, + %% Unrool stacked errors and report them + ?DICT:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, SupName) + end, ok, EStack). + + +monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> + ?SETS:fold(fun(P, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics); +monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> + ?DICT:fold(fun(P, _, {Pids, EStack}) -> + case monitor_child(P) of + ok -> + {?SETS:add_element(P, Pids), EStack}; + {error, normal} when RType =/= permanent -> + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} + end + end, {?SETS:new(), ?DICT:new()}, Dynamics). + + +wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> + EStack; +wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> + %% If the timer has expired before its cancellation, we must empty the + %% mail-box of the 'timeout'-message. + erlang:cancel_timer(TRef), + receive + {timeout, TRef, kill} -> + EStack + after 0 -> + EStack + end; +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, killed} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)) + end; +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, + TRef, EStack) -> + receive + {'DOWN', _MRef, process, Pid, shutdown} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + + {'DOWN', _MRef, process, Pid, Reason} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)); + + {timeout, TRef, kill} -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) + end. + %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- @@ -1053,7 +1157,7 @@ validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). validShutdown(Shutdown, _) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; +validShutdown(infinity, _) -> true; validShutdown(brutal_kill, _) -> true; validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). @@ -1134,12 +1238,19 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). -extract_child(Child) -> +extract_child(Child) when is_pid(Child#child.pid) -> [{pid, Child#child.pid}, {name, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, + {child_type, Child#child.child_type}]; +extract_child(Child) -> + [{nb_children, length(Child#child.pid)}, + {name, Child#child.name}, + {mfargs, Child#child.mfargs}, + {restart_type, Child#child.restart_type}, + {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]. report_progress(Child, SupName) -> |