The R13B03 release.OTP_R13B03

1 files changed, 1093 insertions, 0 deletions

diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl
new file mode 100644
index 0000000000..e3d44d00b9
--- /dev/null
+++ b/lib/stdlib/test/ets_tough_SUITE.erl
@@ -0,0 +1,1093 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2009. 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(ets_tough_SUITE).
+-export([all/1,ex1/1]).
+-export([init/1,terminate/2,handle_call/3,handle_info/2]).
+-export([init_per_testcase/2, fin_per_testcase/2]).
+-compile([export_all]).
+-include("test_server.hrl").
+
+all(suite) -> [ex1].
+
+
+-define(DEBUG(X),debug_disabled).
+%%-define(DEBUG(X),X).
+-define(GLOBAL_PARAMS,ets_tough_SUITE_global_params).
+
+init_per_testcase(_Func, Config) ->
+    Dog=test_server:timetrap(test_server:seconds(300)),
+    [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+    Dog=?config(watchdog, Config),
+    test_server:timetrap_cancel(Dog),
+    ets:delete(?GLOBAL_PARAMS).
+
+
+ex1(Config) when list(Config) ->
+    ?line ets:new(?GLOBAL_PARAMS,[named_table,public]),
+    ?line ets:insert(?GLOBAL_PARAMS,{a,set}),
+    ?line ets:insert(?GLOBAL_PARAMS,{b,set}),
+    ?line ex1_sub(Config),
+    ?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
+    ?line ets:insert(?GLOBAL_PARAMS,{b,set}),
+    ?line ex1_sub(Config),
+    ?line ets:insert(?GLOBAL_PARAMS,{a,ordered_set}),
+    ?line ets:insert(?GLOBAL_PARAMS,{b,ordered_set}),
+    ?line ex1_sub(Config).    
+    
+    
+
+
+ex1_sub(Config) ->
+    {A,B} = prep(Config),
+    N = 
+	case ?config(ets_tough_SUITE_iters,Config) of
+	    undefined ->
+		5000;
+	    Other -> 
+		Other
+	end,
+    {NewA,NewB} = run({A,B},N),
+    _Gurkor = lists:keysearch(gurka,1,ets:all()),
+    (catch stop(NewA)),
+    (catch stop(NewB)),
+    ok.
+
+prep(Config) ->
+    random:seed(),
+    put(dump_ticket,none),
+    DumpDir = filename:join(?config(priv_dir,Config), "ets_tough"),
+    file:make_dir(DumpDir),
+    put(dump_dir,DumpDir),
+    process_flag(trap_exit,true),
+    {ok, A} = start(a),
+    {ok, B} = start(b),
+    {A,B}.
+
+run({A,B},N) ->
+    run(A,B,0,N).
+
+run(A,B,N,N) ->
+    {A,B};
+run(A,B,N,M) ->
+    eat_msgs(),
+    Op = random_operation(),
+    ?DEBUG(io:format("~w: ",[N])),
+    case catch operate(Op,A,B) of
+	{'EXIT',Reason} ->
+	    io:format("\nFAILURE on ~w: ~w, reason: ~w\n",[N,Op,Reason]),
+	    exit(failed);
+	{new_a,NewA} ->
+	    run(NewA,B,N+1,M);
+	_ ->
+	    run(A,B,N+1,M)
+    end.
+
+eat_msgs() ->
+    receive
+	_Anything ->
+	    eat_msgs()
+    after 0 ->
+	    ok
+    end.
+
+operate(get,A,B) ->
+    case random_key() of
+	1 ->
+	    Class = random_class(),
+	    AnsA = lists:sort(dget_class(A,Class,all)),
+	    AnsB = lists:sort(dget_class(B,Class,all)),
+	    ?DEBUG(io:format("get_class ~w (~w)\n",[Class,AnsA])),
+	    AnsA = AnsB;
+	_Other ->
+	    Class = random_class(),
+	    Key = random_key(),
+	    AnsA = dget(A,Class,Key),
+	    AnsB = dget(B,Class,Key),
+	    ?DEBUG(io:format("get ~w,~w (~w)\n",[Class,Key,AnsA])),
+	    AnsA = AnsB
+    end;
+
+operate(put,A,B) ->
+    Class = random_class(),
+    Key = random_key(),
+    Value = random_value(),
+    AnsA = dput(A,Class,Key,Value),
+    AnsB = dput(B,Class,Key,Value),
+    ?DEBUG(io:format("put ~w,~w=~w (~w)\n",[Class,Key,Value,AnsA])),
+    AnsA = AnsB;
+
+operate(erase,A,B) ->
+    case random_key() of
+	1 ->
+	    Class = random_class(),
+	    AnsA = derase_class(A,Class),
+	    AnsB = derase_class(B,Class),
+	    ?DEBUG(io:format("erase_class ~w\n",[Class])),
+	    AnsA = AnsB;
+	_Other ->
+	    Class = random_class(),
+	    Key = random_key(),
+	    AnsA = derase(A,Class,Key),
+	    AnsB = derase(B,Class,Key),
+	    ?DEBUG(io:format("erase ~w,~w (~w)\n",[Class,Key,AnsA])),
+	    AnsA = AnsB
+    end;
+
+operate(dirty_get,A,_B) ->
+    Class = random_class(),
+    Key = random_key(),
+    %% only try dirty get on the b-side (which is never dumping)
+    AnsA = dget(A,Class,Key),
+    AnsB = dirty_dget(b,Class,Key),
+    ?DEBUG(io:format("dirty_get ~w,~w (~w)\n",[Class,Key,AnsA])),
+    AnsA = AnsB;
+
+operate(dump,A,_B) ->
+    case get(dump_ticket) of
+	{dump_more,Ticket} ->
+	    Units = random_key(),
+	    NewTicket = ddump_next(A,Units,Ticket),
+	    put(dump_ticket,NewTicket),
+	    _Result = case NewTicket of
+			 done -> done;
+			 _ ->    dump_more
+		     end,
+	    ?DEBUG(io:format("dump ~w (~w)\n",[Units,_Result]));
+	_ ->
+	    DumpDir = get(dump_dir),
+	    case random_key() of
+		1 ->
+		    ?DEBUG(io:format("start_dump\n",[])),
+		    NewTicket = ddump_first(A,DumpDir),
+		    put(dump_ticket,NewTicket);
+		2 ->
+		    ?DEBUG(io:format("dump_and_restore\n",[])),
+		    {dump_more,NewTicket} = ddump_first(A,DumpDir),
+		    done = ddump_next(A,1000000,NewTicket),
+		    stop(A),
+		    {ok, NewA} = start(a,DumpDir),
+		    {new_a,NewA};
+		_ ->
+		    ?DEBUG(io:format("idle\n",[])),
+		    ok
+	    end
+    end.
+    
+random_operation() ->
+    Ops = {get,put,erase,dirty_get,dump},
+    random_element(Ops).
+
+random_class() ->
+    Classes = {foo,bar,tomat,gurka},
+    random_element(Classes).
+
+random_key() ->
+    random:uniform(8).
+
+random_value() ->
+    case random:uniform(5) of
+	1 -> ok;
+	2 -> {data,random_key()};
+	3 -> {foo,bar,random_class()};
+	4 -> random:uniform(1000);
+	5 -> {recursive,random_value()}
+    end.
+
+random_element(T) ->
+    I = random:uniform(tuple_size(T)),
+    element(I,T).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+show_table(N) ->
+    FileName = ["etsdump.",integer_to_list(N)],
+    case file:open(FileName,read) of
+	{ok,Fd} ->
+	    show_entries(Fd);
+	_ ->
+	    error
+    end.
+	    
+show_entries(Fd) ->
+    case phys_read_len(Fd) of
+	{ok,Len} ->
+	    case phys_read_entry(Fd,Len) of
+		{ok,ok} ->
+		    ok;
+		{ok,{Key,Val}} ->
+		    io:format("~w\n",[{Key,Val}]),
+		    show_entries(Fd);
+		_ ->
+		    error
+	    end;
+	_ ->
+	    error
+    end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% DEFINITIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(NAMED_TABLES,true).
+-define(DB_NAME_KEY, {'$db_name'}).
+-define(LIST_OF_CLASSES_KEY,{'$list_of_classes'}).
+-define(DUMPING_FLAG_KEY,{'$dumping_flag'}).
+-define(DUMP_DIRECTORY_KEY,{'$dump_directory'}).
+-define(ERASE_MARK(Key),{{{'$erased'},Key}}).
+-define(ets_new,ets:new).
+-define(ets_lookup,ets:lookup).
+-define(ets_insert,ets:insert).    % erlang:db_put
+-define(ets_delete,ets:delete).    % erlang:db_erase
+-define(ets_first,ets:first).      % erlang:db_first
+-define(ets_next,ets:next).        % erlang:db_next_key
+-define(ets_info,ets:info).        % erlang:db_info
+
+%%% INTERFACE FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% start(DbName) -> Pid | {error,Reason}
+%%%
+%%% Starts the ets table database with name DbName
+
+start(DbName) ->
+    case gen_server:start_link(ets_tough_SUITE,{DbName,no_dump_dir},[]) of
+	{ok,Pid} when pid(Pid) ->
+	    {ok, Pid};
+	Other ->
+	    Other
+    end.
+
+%%% start(DbName,DumpDir) -> Pid | {error,Reason}
+%%%
+%%% Starts the ets table database with name DbName, and reads a dump
+%%% from DumpDir when it starts.
+
+start(DbName,DumpDir) ->
+    case gen_server:start_link(ets_tough_SUITE,
+			       {DbName,{dump_dir,DumpDir}},[]) of
+	{ok,Pid} when pid(Pid) ->
+	    {ok, Pid};
+	Other ->
+	    Other
+    end.
+
+%%% stop(ServerPid) -> {'EXIT',shutdown}
+%%%
+%%% Shuts down the ets table database
+
+stop(ServerPid) ->
+    gen_server:call(ServerPid,stop).
+
+%%% dget(ServerPid,Class,Key) -> {value,Value} | undefined
+%%%
+%%% Returns a value identified by Class,Key from the database, or
+%%% 'undefined' if there is no such value.
+
+dget(ServerPid,Class,Key) ->
+    gen_server:call(ServerPid,{handle_lookup,Class,Key}).
+
+%%% dirty_dget(DbName,Class,Key) -> {value,Value} | undefined
+%%%
+%%% This is looks up the value directly in the ets table
+%%% to avoid message passing. Several databases may be started,
+%%% so the admin table must be registered.
+
+dirty_dget(DbName,Class,Key) ->
+    Admin = admin_table_name(DbName),
+    case catch(?ets_lookup(Admin,Class)) of
+	[{_Class,[Tab|_Tabs]}] ->
+	    case ?ets_lookup(Tab,Key) of
+		[{_Key,Value}] ->
+		    {value,Value};
+		_ ->
+		    undefined
+	    end;
+	_ ->
+	    undefined
+    end.
+
+%%% dput(ServerPid,Class,Key,Value) -> undefined | {value,OldValue}
+%%%
+%%% Inserts the given Value to be identified by Class,Key. Any prevoius
+%%% value is returned, or otherwise 'undefined'.
+
+dput(ServerPid,Class,Key,Value) ->
+    gen_server:call(ServerPid,{handle_insert,Class,Key,Value}).
+
+%%% derase(ServerPid,Class,Key) -> undefined | {value,OldValue}
+%%%
+%%% Erases any value identified by Class,Key
+
+derase(ServerPid,Class,Key) ->
+    gen_server:call(ServerPid,{handle_delete,Class,Key}).
+
+%%% dget_class(ServerPid,Class,Condition) -> KeyList
+%%%
+%%% Returns a list of keys where the instance match Condition.
+%%% Condition = 'all' returns all keys in the class.
+%%% The condition is supplied as Condition = {Mod, Fun, ExtraArgs},
+%%% where the instance will be prepended to ExtraArgs before each
+%%% call is made.
+
+dget_class(ServerPid,Class,Condition) ->
+    gen_server:call(ServerPid,
+		       {handle_get_class,Class,Condition},infinity).
+
+%%% derase_class(ServerPid,Class) -> ok
+%%%
+%%% Erases a whole class, identified by Class
+
+derase_class(ServerPid,Class) ->
+    gen_server:call(ServerPid,{handle_delete_class,Class}, infinity).
+
+%%% dmodify(ServerPid,Application) -> ok
+%%%
+%%% Applies a function on every instance in the database.
+%%% The user provided function must always return one of the
+%%% terms {ok,NewItem}, true, or false.
+%%% Aug 96, this is only used to reset all timestamp values
+%%% in the database.
+%%% The function is supplied as Application = {Mod, Fun, ExtraArgs},
+%%% where the instance will be prepended to ExtraArgs before each
+%%% call is made.
+
+dmodify(ServerPid,Application) ->
+    gen_server:call(ServerPid,{handle_dmodify,Application}, infinity).
+
+%%% ddump_first(ServerPid,DumpDir) -> {dump_more,Ticket} | already_dumping
+%%%
+%%% Starts dumping the database. This call redirects all database updates
+%%% to temporary tables, so that exactly the same database image will be
+%%% written to disk as is in memory when this function is called.
+%%% The returned Ticket is to be used with ddump_next/2
+
+ddump_first(ServerPid,DumpDir) ->
+    gen_server:call(ServerPid,{handle_dump_first,DumpDir}, infinity).
+
+%%% ddump_next(ServerPid,Count,Ticket) -> {dump_more,Ticket} | done
+%%%
+%%% Dumps the database. This function performs Count units of dump work.
+%%% Higher value of Count makes the entire dump operation more efficient,
+%%% but blocks the database for longer periods of time.
+%%% If there is still more work to be done, a new Ticket is returned,
+%%% or 'done' otherwise.
+
+ddump_next(ServerPid,Count,Ticket) ->
+    gen_server:call(ServerPid,{handle_dump_next,Ticket,Count},150000).
+
+%%% PRIVATE HANDLER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Admin
+%%% -----
+%%%
+%%% The database has a main administrative table Admin. It always contains
+%%% these four items:
+%%%
+%%%    {{'$db_name'},Name}
+%%%    {{'$list_of_classes'},ListOfClasses}
+%%%    {{'$dumping_flag'},BoolDumping}
+%%%    {{'$dump_directory'},Dir}
+%%%
+%%% The ListOfClasses is simply a list of all Classes that has ever been
+%%% inserted in the database. It's used to know which tables to dump.
+%%% The dump flag is 'true' while dump is in progress, to make it
+%%% impossible to start a new dump before an old dump is completed.
+%%%
+%%% For each class there is an entry of the form
+%%%
+%%%    {Class,ListOfTables}
+%%%
+%%% Where the ListOfTables is the list of class tables (see below)
+%%%
+%%% Class Tables
+%%% ------------
+%%%
+%%% The class tables are common ets tables that have the actual user
+%%% data stored in them.
+%%%
+%%% Normally there is only one class table, Mtab (main table).
+%%% When dumping is initiated, each class is syncronously given a 
+%%% temporary table, Ttab, where all updates are stored. Reads are 
+%%% directed to the Ttab first, and only if not found there, Mtab is
+%%% consulted.
+%%%
+%%% Writes always go to the first table in the table sequence. This
+%%% ensures that the dump algorithm can enumerate the entries in the
+%%% other tables, without risk of being disrupted.
+%%%
+%%% When the dumping to disk is completed, it's time to write back
+%%% whatever updates that came into the Ttab to Mtab. To do this, a
+%%% third table is needed, Utab, to handle all updates while Ttab is
+%%% being copied to Mtab. When all of Ttab is copied, Ttab is thrown
+%%% away, and the whole process is repeated with Utab as Ttab until
+%%% eventually nobody wrote to Utab while Ttab was copied (clean run).
+%%%
+%%% There is no _guarantee_ that this will ever happen, but unless there
+%%% is a constant (and quite high frequency) stream of updates to a
+%%% particular class, this should work.
+%%%
+%%% (It is possible to make this failsafe, by copying the elements in
+%%% Mtab to Ttab. This is probably a lot more expensive, though)
+%%%
+%%% Erasure during dump
+%%% -------------------
+%%%
+%%% Erasing need special attention when a single class has several 
+%%% tables. It really boils down to a number of cases:
+%%% 
+%%% - element does not exist in Ttab.
+%%%     A special erase record is written, {{{'$erased'},Key}} which
+%%%     is hopefully different from all other keys used by the user.
+%%% - element exists in Ttab
+%%%     The element is deleted, and erase record is written
+%%% - element does not exist in Ttab, but there is an erase record
+%%%     fine, do nothing
+%%% - element exist in Ttab, and there is an erase record
+%%%     This happens when a record is deleted from Ttab, then written
+%%%     back again. Erase records are not looked for when inserting
+%%%     new data (and that's not necessary)
+%%%
+%%% Then when Ttab should be copied to Mtab:
+%%%
+%%% - found an element
+%%%     Usual case, just copy
+%%% - found erase record
+%%%     Check if there is an element with the same key as the erase
+%%%     record. If so it has been written later than the erasure, so
+%%%     the erasure is obsolete. Otherwise erase the record from Mtab.
+%%%
+%%% Delete Class
+%%% ------------
+%%%
+%%% A slight problem is deleting an entire class while dumping is in
+%%% progress. For consitency, all user visible traces of the class must
+%%% be deleted, while dumping must not be affected. On top of that, the
+%%% deleted class may well be recreated while dumping is still going on,
+%%% and entries added.
+%%%
+%%% This is solved by having the dump algorithm keep track of the table
+%%% identifiers of the tables to dump, rather than asking the admin table
+%%% (since the class might be deleted there). The dump algorithm will
+%%% itself take care of deleting the tables used in the dumping, while the
+%%% normal database interface deletes the "first table", the table that is
+%%% currently accepting all write operations.
+
+
+init({DbName,DumpDir}) ->
+    case DumpDir of
+	no_dump_dir ->
+	    Admin = make_admin_table(DbName),
+	    ?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[]}),
+	    init2(DbName,Admin);
+	{dump_dir,Dir} ->
+	    case load_dump(DbName,Dir) of
+		{ok,Admin} ->
+		    ?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,Dir}),
+		    init2(DbName,Admin);
+		_ ->
+		    cant_load_dump
+	    end
+    end.
+
+init2(DbName,Admin) ->
+    ?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
+    ?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
+    {ok, Admin}.
+
+terminate(_Reason,_Admin) ->
+    ok.
+
+handle_call({handle_lookup,Class,Key},_From,Admin) ->
+    %% Lookup tables to search in
+    Reply =
+	case ?ets_lookup(Admin,Class) of
+	    [] ->
+		undefined; %% no such class => no such record
+	    [{_,TabList}] ->
+		{_,Ans} = table_lookup(TabList, Key),
+		Ans
+	end,
+    {reply,Reply,Admin};
+
+handle_call({handle_insert,Class,Key,Value},_From,Admin) ->
+    %% Lookup in which table to write
+    Reply = 
+	case ?ets_lookup(Admin,Class) of
+	    [] ->
+		%% undefined class, let's create it
+		Mtab = make_db_table(db_name(Admin),Class),
+		?ets_insert(Admin,{Class,[Mtab]}),
+		[{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
+		?ets_insert(Admin,{?LIST_OF_CLASSES_KEY,[Class|Classes]}),
+		?ets_insert(Mtab, {Key, Value}),
+		undefined;
+	    [{_,[Tab|Tabs]}] ->
+		{_,Old} = table_lookup([Tab|Tabs], Key),
+		?ets_insert(Tab, {Key, Value}),
+		Old
+	end,
+    {reply,Reply,Admin};
+
+handle_call({handle_delete,Class,Key},_From,Admin) ->
+    %% Lookup in which table to write
+    Reply =
+	case ?ets_lookup(Admin, Class) of
+	    [] ->
+		undefined; %% no such class, but delete is happy anyway
+	    [{_,[Tab]}] ->
+		%% When there is only one table, simply deleting is enough
+		{_,Old} = table_lookup(Tab,Key),
+		?ets_delete(Tab,Key),
+		Old;
+	    [{_,[Tab|Tabs]}] ->
+		%% When there are more tables, we have to write a delete
+		%% record into the first one, so that nobody goes looking
+		%% for this entry in some other table
+		{_,Old} = table_lookup([Tab|Tabs],Key),
+		?ets_insert(Tab, {?ERASE_MARK(Key), erased}),
+		?ets_delete(Tab,Key),
+		Old
+	end,
+    {reply,Reply,Admin};
+
+handle_call({handle_get_class,Class,Cond},_From,Admin) ->
+    Reply =
+	case ?ets_lookup(Admin,Class) of     % Lookup tables to search in
+	    [] ->
+		[];          % no such class
+	    [{_,TabList}] ->
+		table_lookup_batch(TabList, Class, Cond)  % get class data
+	end,
+    {reply,Reply,Admin};
+
+handle_call({handle_delete_class,Class},_From,Admin) ->
+    Reply =
+	case ?ets_lookup(Admin, Class) of
+	    [] ->
+		ok;     % no such class, but delete_class is happy anyway
+	    [{_,[Tab|_Tabs]}] ->
+		%% Always delete the first table (the one we're writing into)
+		%% In case we're dumping, the rest of the tables will be
+		%% taken care of by the dump algorithm.
+		?ets_delete(Tab),
+		[{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
+		NewClasses = lists:delete(Class, Classes),
+		?ets_insert(Admin, {?LIST_OF_CLASSES_KEY, NewClasses}),
+		?ets_delete(Admin, Class),
+		ok
+	end,
+    {reply,Reply,Admin};
+
+handle_call({handle_dmodify,Application},_From,Admin) ->
+    [{_, Classes}] = ?ets_lookup(Admin, ?LIST_OF_CLASSES_KEY),
+    modify(Application, Classes, Admin),
+    {reply,ok,Admin};
+
+handle_call({handle_dump_first,DumpDir},_From,Admin) ->
+    case ?ets_lookup(Admin,?DUMPING_FLAG_KEY) of
+	[{_,true}] ->
+	    {reply,already_dumping,Admin};
+	_ ->
+	    phys_remove_ok(DumpDir),
+	    [{_,Classes}] = ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY),
+	    Tables = dump_prepare_classes(Classes,Admin),
+	    ?ets_insert(Admin,{?DUMPING_FLAG_KEY,true}),
+	    %% this is the new dir for dumping:
+	    ?ets_insert(Admin,{?DUMP_DIRECTORY_KEY,DumpDir}),
+	    handle_dump_next({[{admin,Classes}|Tables]},0,Admin)
+    end;
+
+%% All done, good work!
+handle_call({handle_dump_next,Ticket,Count},_From,Admin) ->
+    handle_dump_next(Ticket,Count,Admin);
+
+handle_call(stop,_From,Admin) ->
+    ?ets_delete(Admin), % Make sure table is gone before reply is sent.
+    {stop, normal, ok, []}.
+
+handle_info({'EXIT',_Pid,_Reason},Admin) ->
+    {stop,normal,Admin}.
+
+handle_delete(Class, Key, Admin) ->
+    handle_call({handle_delete,Class,Key},from,Admin).
+
+handle_insert(Class, Key, Value, Admin) ->
+    handle_call({handle_insert,Class,Key,Value},from,Admin).
+
+handle_lookup(Class, Key, Admin) ->
+    handle_call({handle_lookup,Class,Key},from,Admin).
+
+
+handle_dump_next({[]},_Count,Admin) ->
+    [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
+    phys_ok_dump(DumpDir),
+    ?ets_insert(Admin,{?DUMPING_FLAG_KEY,false}),
+    {reply,done,Admin};
+
+%% No more operations, return to user asking for more
+handle_dump_next(Ticket,0,Admin) ->
+    {reply,{dump_more,Ticket},Admin};
+
+%% Dump the admin table. Costs one dump-work unit.
+handle_dump_next({[{admin,Classes}|Tables]},Count,Admin) ->
+    [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
+    DumpData = phys_init_dump(admin,DumpDir,0),
+    phys_dump({?LIST_OF_CLASSES_KEY,Classes},DumpData),
+    phys_finish_dump(DumpData),
+    handle_dump_next({Tables},Count-1,Admin);
+
+%% Pick out a class and start dumping it
+handle_dump_next({[{Class,Mtab}|Tables]},Count,Admin) ->
+    ?DEBUG(io:format("DUMP CLASS ~w\n",[Class])),
+    [{_Key,DumpDir}] = ?ets_lookup(Admin,?DUMP_DIRECTORY_KEY),
+    DumpData = phys_init_dump(Class,DumpDir,length(Tables)+1),
+    First = ?ets_first(Mtab),
+    handle_dump_next({Class,Tables,Mtab,First,DumpData},Count,Admin);
+
+%% All keys in this class have been written to disk, now we have to
+%% copy all items from temporary Ttab to main Mtab
+handle_dump_next({Class,Tables,Stab,'$end_of_table',DumpData},Count,Admin) ->
+    phys_finish_dump(DumpData),
+    ?DEBUG(io:format("Cleaning up temporary table in ~p\n",[Class])),
+    case ?ets_lookup(Admin,Class) of
+	[{Key,[Utab,Mtab]}] ->
+	    Ttab = make_db_table(db_name(Admin),Class),
+	    ?ets_insert(Admin,{Key,[Ttab,Utab,Mtab]}),
+	    First = ?ets_first(Utab),
+	    handle_dump_next({3,Class,Tables,Utab,First,Mtab},Count,Admin);
+	_Other ->
+	    %% Class deleted (and maybe recreated) while dumping, no need to 
+	    %% bring this one up to date. Just discard late additions.
+	    ?ets_delete(Stab),
+	    handle_dump_next({Tables},Count,Admin)
+    end;
+
+%% Dumping one key to disk. Costs one dump-work unit.
+handle_dump_next({Class,Tables,Tab,Key,DumpData},Count,Admin) ->
+    [KeyVal] = ?ets_lookup(Tab,Key),
+    phys_dump(KeyVal,DumpData),
+    NextKey = ?ets_next(Tab,Key),
+    handle_dump_next({Class,Tables,Tab,NextKey,DumpData},Count-1,Admin);
+
+%% Done copying elements from Ttab to Mtab
+%% check if Utab is empty and go on with next class, or
+%% make Utab the current Ttab, and run again
+%% ... will this ever end? ;-)
+handle_dump_next({3,Class,Tables,Stab,'$end_of_table',Dtab},Count,Admin) ->
+    case ?ets_lookup(Admin,Class) of
+	[{Key,[Ttab,Utab,Mtab]}] ->
+	    case ?ets_info(Ttab,size) of
+		0 ->
+		    ?ets_insert(Admin,{Key,[Mtab]}),
+		    ?ets_delete(Ttab),
+		    ?ets_delete(Utab),
+		    handle_dump_next({Tables},Count,Admin);
+		_Work ->
+		    ?DEBUG(io:format("Switching direction in ~p\n",[Class])),
+		    %% Which is faster, deleting all the entries
+		    %% in a table, or deleting it and create a new?
+		    ?ets_delete(Utab),
+		    Ntab = make_db_table(db_name(Admin),Class),
+		    ?ets_insert(Admin,{Key,[Ntab,Ttab,Mtab]}),
+		    First = ?ets_first(Ttab),
+		    handle_dump_next({3,Class,Tables,Ttab,First,Mtab},
+				     Count,Admin)
+	    end;
+	_Other ->
+	    %% Class deleted (and maybe recreated) while dumping, no need to 
+	    %% bring this one up to date. Just discard late additions.
+	    ?ets_delete(Stab),
+	    ?ets_delete(Dtab),
+	    handle_dump_next({Tables},Count,Admin)
+    end;
+
+%% Copy one key from Ttab to Mtab
+%% costs one dump-work unit
+handle_dump_next({3,Class,Tables,Stab,Key,Dtab},Count,Admin) ->
+    copy_dump_entry(Stab,Key,Dtab),
+    NextKey = ?ets_next(Stab,Key),
+    handle_dump_next({3,Class,Tables,Stab,NextKey,Dtab},Count-1,Admin).
+
+%%% INTERNAL HELPER FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% admin_table_name(DbName) -> Name
+%%%
+%%% Returns the name of the admin table of the table DbName
+
+admin_table_name(DbName) ->
+    list_to_atom(lists:append(atom_to_list(DbName),"#admin")).
+
+%%% make_admin_table(DbName) -> EtsAdminTable
+%%%
+%%% Creates and registers an ETS Admin table
+
+make_admin_table(DbName) ->
+    ?ets_new(admin_table_name(DbName),[named_table,protected,db_type(DbName)]).
+
+%%% make_db_table(DbName,Name) -> EtsTable
+%%%
+%%% Creates an ETS database table
+
+make_db_table(DbName, Name) ->
+    ?ets_new(Name,[protected,db_type(DbName)]).
+
+db_name(Admin) ->
+    ets:lookup_element(Admin,?DB_NAME_KEY,2).
+
+db_type(DbName) ->
+    case ets:lookup(?GLOBAL_PARAMS, DbName) of
+	[] ->
+	    set;
+	[{DbName,X}] ->
+	    X
+    end.
+
+%%% table_lookup(Table,Key) -> 
+%%% table_lookup(TableList,Key) ->
+%%%    {def,{value,Value}} | {undef,undefined} | (erased,undefined}
+%%%
+%%% Looks up key in the table and returns it value, or undefined
+%%% if there is no such key.
+%%% If a list of tables is given, they are searched one after another
+%%% for a matching key, until one is found. The search is discontinued
+%%% if a record telling that the key was deleted is found.
+
+table_lookup([], _Key) ->
+    {undef,undefined};
+table_lookup([Table|Tables], Key) ->
+    case table_lookup(Table,Key) of
+	{_,undefined} ->
+	    case ?ets_lookup(Table,?ERASE_MARK(Key)) of
+		[] ->
+		    table_lookup(Tables,Key);
+		_Definition ->
+		    %% The element has been deleted, don't look further!
+		    %% Pretend we never saw anything..
+		    {erased,undefined}
+	    end;
+	Answer ->
+	    Answer
+    end;
+table_lookup(Table, Key) ->
+    case ?ets_lookup(Table,Key) of
+	[] ->
+	    {undef,undefined};
+	[{_Key,Value}] ->
+	    {def,{value,Value}}
+    end.
+
+%%% table_lookup_batch(Tables, Class, Cond) -> KeyList
+%%%
+%%% Extract the keys from a table or a table group.
+%%% If a condition is supplied, it is on the form {Mod, Fun, ExtraArgs}
+%%% and returns {true,Key} or false when called using
+%%% apply(Mod, Fun, [Instance|ExtraArgs]).
+%%% Instance is, for historic reasons, {{Class, Key}, Value} when the function
+%%% is called. Cond = 'all' can be used to get all keys from a class.
+
+table_lookup_batch([],_Class,_Cond) ->
+    [];
+table_lookup_batch([Table|Tables],Class,Cond) ->
+    table_lookup_batch([],Tables,Table,ets:first(Table),Class,Cond,[]).
+    
+table_lookup_batch(_Passed,[],_,'$end_of_table',_Class,_Cond,Ack) ->
+    Ack;
+table_lookup_batch(Passed,[NewTable|Tables],Table,'$end_of_table',
+		   Class,Cond,Ack) ->
+    table_lookup_batch(lists:append(Passed,[Table]),Tables,
+		       NewTable,ets:first(NewTable),Class,Cond,Ack);
+table_lookup_batch(Passed,Tables,Table,?ERASE_MARK(Key),Class,Cond,Ack) ->
+    table_lookup_batch(Passed,Tables,Table,?ets_next(Table,?ERASE_MARK(Key)),
+		       Class,Cond,Ack);
+    
+table_lookup_batch(Passed,Tables,Table,Key,Class,Cond,Ack) ->
+    NewAck =
+	case table_lookup(Passed,Key) of
+	    {undef,undefined} ->
+		[{_Key,Value}] = ?ets_lookup(Table,Key),
+		case Cond of    % are there any conditions?
+		    all ->
+			[Key|Ack];
+		    {M, F, A} ->
+			%% apply the condition test.
+			%% Applications need keys to consist of
+			%% {class, primkey}, so we make it that way
+			case apply(M, F, [{{Class, Key}, Value}|A]) of
+			    {true, Key} -> [Key|Ack];
+			    false ->       Ack
+			end
+		end;
+	    _Other -> 
+		%% Already processed (or erased) key
+		%% {def,{value,Value}} ->
+		%% {erased,undefined} ->
+		Ack
+	end,
+    table_lookup_batch(Passed,Tables,Table,?ets_next(Table,Key),
+		       Class,Cond,NewAck).
+
+%%% modify(Application, ClassList, Admin) -> ok.
+%%%
+%%% This function modifies each element of the classes
+
+modify(_Application, [], _Admin) ->
+    ok;
+modify(Application, [Class|Classes], Admin) ->
+    ?DEBUG(io:format("modifying class ~p\n", [Class])),
+    [{_,Tables}] = ?ets_lookup(Admin, Class),
+    modify_class(Application, Class, table_lookup_batch(Tables, Class, all),
+		 Admin),
+    modify(Application, Classes, Admin).
+
+modify_class(_Application, _Class, [], _Admin) ->
+    ok;
+modify_class({Mod, Fun, ExtraArgs}, Class, [Key|Keys], Admin) ->
+    {ok, {{value, Value}, _Admin}} = handle_lookup(Class, Key, Admin),
+    %% The applications think that a key consists of {class, primkey},
+    %% so let them.
+    case apply(Mod,Fun,[{{Class, Key}, Value}|ExtraArgs]) of
+	{ok,{{NewClass, NewKey}, NewValue}} ->   % The item is modified.
+	    %% remove old instance, insert new
+	    %% JALI could be optimized (we don't care about previous values),
+	    %% but ets_delete/insert is *not* enough
+	    handle_delete(Class, Key, Admin),
+	    handle_insert(NewClass, NewKey, NewValue, Admin);
+	true ->                           % The item should be left as it is.
+	    ok;
+	false ->                          % The item should be removed!
+	    %% JALI could be optimized (we don't care about previous values),
+	    %% but ets_delete is *not* enough
+	    handle_delete(Class, Key, Admin)
+    end,
+    modify_class({Mod, Fun, ExtraArgs}, Class, Keys, Admin).
+
+%%% dump_prepare_classes(Classes,Admin) -> ok
+%%%
+%%% Create a Ttab for each class, and insert 
+%%% the new table order in Admin
+
+dump_prepare_classes(Classes,Admin) ->
+    ?DEBUG(io:format("DUMP CLASSES ~w\n",[Classes])),
+    dump_prepare_classes(Classes,Admin,[]).
+
+dump_prepare_classes([],_Admin,Ack) ->
+    Ack;
+dump_prepare_classes([Class|Classes],Admin,Ack) ->
+    [{_Class,[Mtab]}] = ?ets_lookup(Admin,Class),
+    %% Only one table => we can prepare for dumping
+    %% In case there are several tables defined, dumping is
+    %% already (still) in progress for this class (database inconsistent)
+    Ttab = make_db_table(db_name(Admin),Class),
+    ?ets_insert(Admin,{Class,[Ttab,Mtab]}),
+    dump_prepare_classes(Classes,Admin,lists:append(Ack,[{Class,Mtab}])).
+
+%%% copy_dump_entry(SourceTable,Key,DestinationTable) -> NobodyCares
+%%%
+%%% Copies Key from SourceTable to DestinationTable.
+%%% If Key is an erase record, then the corresponding entry is deleted
+%%% from DestinationTable, if it should be (see Erasure during dump, above)
+
+copy_dump_entry(Stab,Key,Dtab) ->
+    ?DEBUG(io:format("Copying key ~p\n",[Key])),
+    case ?ets_lookup(Stab,Key) of
+	[{?ERASE_MARK(RealKey),_}] ->
+	    %% Only erase if the entry RealKey hasn't been written again
+	    case ?ets_lookup(Stab,RealKey) of
+		[] ->
+		    %% No, it hasn't: we should delete
+		    ?DEBUG(io:format("Erasing: ~p\n",[RealKey])),
+		    ?ets_delete(Dtab,RealKey);
+		_Definition ->
+		    %% It has, don't erase. In this case the new value
+		    %% has already or will soon be written to Dtab
+		    ok
+	    end;
+	[KeyVal] ->
+	    ?DEBUG(io:format("Forwarding: ~p\n",[KeyVal])),
+	    ?ets_insert(Dtab,KeyVal)
+    end.
+
+%%% DUMP LOADING %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+load_dump(DbName,DumpDir) ->
+    case phys_load_dump_ok(DumpDir) of
+	ok ->
+	    Admin = make_admin_table(DbName),
+	    ?ets_insert(Admin,{?DB_NAME_KEY,DbName}),
+	    case phys_load_table(DumpDir,0,Admin) of
+		ok ->
+		    load_dump2(DumpDir,Admin);
+		Other ->
+		    load_dump_failed(Admin,[]),
+		    {error,{load_dump1,Other}}
+	    end;
+	Other ->
+	    {error,{load_dump2,Other}}
+    end.
+
+load_dump2(DumpDir,Admin) ->
+    case ?ets_lookup(Admin,?LIST_OF_CLASSES_KEY) of
+	[{_Key,Classes}] ->
+	    case load_dump_tables(DumpDir,Admin,Classes) of
+		ok ->
+		    {ok, Admin};
+		Other ->
+		    io:format("Dumping failed: ~p\n",[Other]),
+		    load_dump_failed(Admin,Classes)
+	    end;
+	Other ->
+	    io:format("Dumping failed2: ~p\n",[Other]),
+	    load_dump_failed(Admin,[])
+    end.
+
+load_dump_failed(Admin,[]) ->
+    ?ets_delete(Admin),
+    {error,load_dump_failed};
+load_dump_failed(Admin,[Class|Classes]) ->
+    case ?ets_lookup(Admin,Class) of
+	[{_Key,[Tab]}] ->
+	    ?ets_delete(Tab);
+	_ ->
+	    ok
+    end,
+    load_dump_failed(Admin,Classes).
+
+load_dump_tables(_DumpDir,_Admin,[]) ->
+    ok;
+load_dump_tables(DumpDir,Admin,[Class|Classes]) ->
+    Mtab = make_db_table(db_name(Admin),Class),
+    ?ets_insert(Admin,{Class,[Mtab]}),
+    Num = length(Classes)+1,
+    case phys_load_table(DumpDir,Num,Mtab) of
+	ok ->
+	    load_dump_tables(DumpDir,Admin,Classes);
+	Other ->
+	    {error,{load_dump_failed,Other}}
+    end.
+
+%%% FILE ACCESS LAYER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% phys_init_dump(Class,DumpDir) -> DumpData
+
+phys_init_dump(Class,DumpDir,Num) ->
+    ?DEBUG(io:format("Opened ~p for writing\n",[Class])),
+    FileName = [DumpDir,"/etsdump.",integer_to_list(Num)],
+    {tag1,{ok,Fd}} = {tag1,file:open(FileName,write)},
+    {Class,Fd}.
+
+%%% phys_finish_dump(DumpData) -> NobodyCares
+
+phys_finish_dump({_Class,Fd}) ->
+    ?DEBUG(io:format("Closed ~p\n",[_Class])),
+    phys_dump_term(Fd,ok),
+    file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
+    ok.
+
+%%% phys_dump(KeyVal,DumpData) -> NobodyCares
+
+phys_dump({Key,Val},{_Class,Fd}) ->
+    ?DEBUG(io:format("To disk (~p.dump): {~p,~p}\n",[_Class,Key,Val])),
+    phys_dump_term(Fd,{Key,Val}),
+    ok.
+
+phys_dump_term(Fd,Term) ->
+    Bin = binary_to_list(term_to_binary(Term)),
+    {tag2,ok} = {tag2,io:put_chars(Fd,encode32(length(Bin)))},
+    {tag3,ok} = {tag3,io:put_chars(Fd,Bin)}.
+
+%%% phys_ok_dump(DumpDir) -> NobodyCares
+
+phys_ok_dump(DumpDir) ->
+    ?DEBUG(io:format("Ok:ing dump dir ~s\n",[DumpDir])),
+    FileName = [DumpDir,"/ok"],
+    {tag4,{ok,Fd}} = {tag4,file:open(FileName,write)},
+    {tag5,ok} = {tag5,io:format(Fd,"ok.\n",[])},
+    file:close(Fd), % JALI: OTP P1D returns true instead of ok, so no check
+    ok.
+
+phys_remove_ok(DumpDir) ->
+    ?DEBUG(io:format("Removing any Ok in dump dir ~s\n",[DumpDir])),
+    FileName = [DumpDir,"/ok"],
+    %% don't care if delete returns ok, file probably doesn't exist
+    file:delete(FileName),
+    ok.
+
+phys_load_dump_ok(DumpDir) ->
+    FileName = [DumpDir,"/ok"],
+    case file:consult(FileName) of
+	{ok,[ok]} ->
+	    ok;
+	Other ->
+	    {error,{consult_error,Other}}
+    end.
+
+phys_load_table(DumpDir,N,Tab) ->
+    ?DEBUG(io:format("LOAD TABLE ~w\n",[N])),
+    FileName = [DumpDir,"/etsdump.",integer_to_list(N)],
+    case file:open(FileName,read) of
+	{ok,Fd} ->
+	    phys_load_entries(Fd,Tab);
+	Other ->
+	    {error,{open_error,Other}}
+    end.
+	    
+phys_load_entries(Fd,Tab) ->
+    case phys_read_len(Fd) of
+	{ok,Len} ->
+	    case phys_read_entry(Fd,Len) of
+		{ok,ok} ->
+		    ok;
+		{ok,{Key,Val}} ->
+		    ?ets_insert(Tab,{Key,Val}),
+		    phys_load_entries(Fd,Tab);
+		Other ->
+		    {error,{read_len,Other}}
+	    end;
+	Other ->
+	    {error,{read_len2,Other}}
+    end.
+
+phys_read_len(Fd) ->
+    case io:get_chars(Fd,'',4) of
+	[A,B,C,D] ->
+	    {ok,decode32(A,B,C,D)};
+	Other ->
+	    {error,{decode,Other}}
+    end.
+
+phys_read_entry(Fd,Len) ->
+    case io:get_chars(Fd,'',Len) of
+	L when list(L), length(L) == Len ->
+	    {ok,binary_to_term(list_to_binary(L))};
+	Other ->
+	    {error,{read_term,Other}}
+    end.
+
+encode32(N) ->
+    [(N bsr 24) band 255, 
+     (N bsr 16) band 255, 
+     (N bsr 8) band 255,
+     N band 255].
+
+decode32(A,B,C,D) ->
+    (A bsl 24) bor (B bsl 16) bor (C bsl 8) bor D.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%