The R13B03 release.OTP_R13B03

1 files changed, 1044 insertions, 0 deletions

diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl
new file mode 100644
index 0000000000..23d1a52b66
--- /dev/null
+++ b/lib/sasl/src/systools_rc.erl
@@ -0,0 +1,1044 @@
+%%
+%% %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(systools_rc).
+-export([translate_scripts/3, translate_scripts/4, format_error/1]).
+
+-include("systools.hrl").
+
+%%-----------------------------------------------------------------
+%% High-level
+%% ==========
+%% mnesia_backup (not yet implemented)
+%% {update, Mod, Change, PrePurge, PostPurge, [Mod]}
+%% {update, Mod, Timeout, Change, PrePurge, PostPurge, [Mod]}
+%% {update, Mod, ModType, , Change, PrePurge, PostPurge, [Mod]}
+%% {update, Mod, ModType, Timeout, Change, PrePurge, PostPurge, [Mod]}
+%% {load_module, Mod, PrePurge, PostPurge, [Mod]}
+%% {add_module, Mod}
+%% {add_module, Mod, [Mod]}
+%% {remove_module, Mod, PrePurge, PostPurge, [Mod]}
+%% {restart_application, Appl}
+%% {add_application, Appl}
+%% {remove_application, Appl}
+%%
+%% Low-level
+%% =========
+%% {load_object_code, {Lib, LibVsn, Mods}}
+%% point_of_no_return
+%% {load, {Mod, PrePurge, PostPurge}}
+%% {remove, {Mod, PrePurge, PostPurge}}
+%% {purge, Mods}
+%% {suspend, Mods}
+%% {resume, Mods}
+%% {code_change, [{Mod, Extra}]}
+%% {code_change, Mode, [{Mod, Extra}]}
+%% {stop, Mods}
+%% {start, Mods}
+%% {sync_nodes, Id, {M, F, A}}
+%% {sync_nodes, Id, Nodes}
+%% {apply, {M, F, A}}
+%% restart_new_emulator
+%%-----------------------------------------------------------------
+
+%% High-level instructions that contain dependencies
+%%
+-define(DEP_INSTRS, [update, load_module, add_module, remove_module]).
+
+%%-----------------------------------------------------------------
+%% translate_scripts(Scripts, Appls, PreAppls) -> Res
+%% Mode = up | dn
+%% Scripts = [AppupScript]
+%% Appls = PreAppls = [#application]
+%% Res = {ok, LowLevelScript} | {error, ?MODULE, Reason}
+%%-----------------------------------------------------------------
+translate_scripts(Scripts, Appls, PreAppls) ->
+    translate_scripts(up, Scripts, Appls, PreAppls).
+
+translate_scripts(Mode, Scripts, Appls, PreAppls) ->
+    Scripts2 = expand_scripts(Scripts),
+    case catch do_translate_scripts(Mode, Scripts2, Appls, PreAppls) of
+	{ok, NewScript} -> {ok, NewScript};
+	{error, Reason} -> {error, ?MODULE, Reason};
+	{'EXIT', Reason} -> {error, ?MODULE, Reason}
+    end.
+
+expand_scripts([Script|Scripts]) ->
+    [expand_script(Script)|expand_scripts(Scripts)];
+expand_scripts([]) ->
+    [].
+
+expand_script([I|Script]) ->
+    I2 = case I of
+	     {load_module, Mod} ->
+		 {load_module, Mod, brutal_purge, brutal_purge, []};
+	     {load_module, Mod, Mods} when is_list(Mods) ->
+		 {load_module, Mod, brutal_purge, brutal_purge, Mods};
+	     {update, Mod} ->
+		 {update, Mod, soft, brutal_purge, brutal_purge, []};
+	     {update, Mod, supervisor} ->
+		 {update, Mod, static, default, {advanced,[]},
+		  brutal_purge, brutal_purge, []};
+	     {update, Mod, Change} when is_tuple(Change) ->
+		 {update, Mod, Change, brutal_purge, brutal_purge, []};
+	     {update, Mod, Change} when Change==soft ->
+		 {update, Mod, Change, brutal_purge, brutal_purge, []};
+	     {update, Mod, Mods} when is_list(Mods) ->
+		 {update, Mod, soft, brutal_purge, brutal_purge, Mods};
+	     {update, Mod, Change, Mods} when is_tuple(Change),
+					      is_list(Mods) ->
+		 {update, Mod, Change, brutal_purge,brutal_purge, Mods};
+	     {update, Mod, Change, Mods} when Change==soft,
+					      is_list(Mods) ->
+		 {update, Mod, Change, brutal_purge,brutal_purge, Mods};
+	     {delete_module, Mod} ->
+		 [{remove, {Mod, brutal_purge, brutal_purge}},
+		  {purge, [Mod]}];
+	     _ ->
+		 I
+	 end,
+    if
+	is_list(I2) ->
+	    I2 ++ expand_script(Script);
+	true ->
+	    [I2|expand_script(Script)]
+    end;
+expand_script([]) ->
+    [].
+
+do_translate_scripts(Mode, Scripts, Appls, PreAppls) ->
+    MergedScript = merge_scripts(Scripts),
+    translate_merged_script(Mode, MergedScript, Appls, PreAppls).
+
+%%-----------------------------------------------------------------
+%% All check_ functions performs checks, and throws {error, Reason}
+%% (or fails) in case of error.  Called functions may throw error or
+%% fail. The script is split into instructions before and after
+%% point_of_no_return.  In Before, only load_object_code and apply are
+%% allowed.
+%% %%-----------------------------------------------------------------
+translate_merged_script(Mode, Script, Appls, PreAppls) ->
+    check_syntax(Script),
+    Script1 = normalize_instrs(Script),
+    {Before, After} = split_script(Script1),
+    check_script(Before, After),
+
+    {Before1, After1} = translate_independent_instrs(Before, After, Appls, PreAppls),
+    {Before2, After2} = translate_dependent_instrs(Mode, Before1, After1, 
+						  Appls),
+    Before3 = merge_load_object_code(Before2),
+    NewScript = Before3 ++ [point_of_no_return | After2],
+    check_syntax(NewScript),
+    {ok, NewScript}.
+
+%%-----------------------------------------------------------------
+%% SPLIT AND MERGE
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% merge_scripts(Scripts) -> Script
+%%
+%% Splits each script into before and after, and merges the before and
+%% after parts.
+%%-----------------------------------------------------------------
+merge_scripts(Scripts) ->
+    {Before, After} =
+	lists:foldl(
+	  fun(Script, {B1, A1}) ->
+		  {B2, A2} = split_script(Script),
+		  {B1 ++ B2, A1 ++ A2}
+	  end, {[], []},Scripts),
+    Before ++ [point_of_no_return | After].
+
+%%-----------------------------------------------------------------
+%% split_script(Script) -> {Before, After}
+%%
+%% Splits the script into instructions before and after
+%% point_of_no_return. Puts all load_object_code instructions in
+%% Before.  Checks that there is at most one point_of_no_return.
+%% Makes sure that if there was a point_of_no_return, only apply and
+%% load_object_code are before the point_of_no_return.
+%%-----------------------------------------------------------------
+split_script(Script) ->
+    {Before, After} = split_instrs(Script),
+    lists:foreach(
+      fun({load_object_code, _}) -> ok;
+	 ({apply, _}) -> ok;
+	 (Instruction) ->
+	      throw({error, {bad_op_before_point_of_no_return,
+			     Instruction}})
+      end, Before),
+    {Found, Rest} = split(fun({load_object_code, _}) -> true;
+			     (_) -> false
+			  end, After),
+    {Before ++ Found, Rest}.
+
+%% split_instrs(Script) -> {Before, After} Split the
+%% instructions into the set of those that appear before
+%% point_of_no_return, and the set of those that appear after. If
+%% there is no point_of_no_return instruction {[], Script} is
+%% returned.
+split_instrs(Script) ->
+    split_instrs(Script, []).
+split_instrs([point_of_no_return | T], Before) ->
+    case lists:member(point_of_no_return, T) of
+	true -> throw({error, too_many_point_of_no_return});
+	false -> {lists:reverse(Before), T}
+    end;
+split_instrs([H | T], Before) ->
+    split_instrs(T, [H | Before]);
+split_instrs([], Before) ->
+    {[], lists:reverse(Before)}.
+
+%%-----------------------------------------------------------------
+%% CHECKS
+%%-----------------------------------------------------------------
+
+check_script(Before, After) ->
+    check_load(Before, After),
+    check_suspend_resume(After),
+    check_start_stop(After).
+
+%%-----------------------------------------------------------------
+%% Checks that each load has a corresponding load_object_code.
+%%-----------------------------------------------------------------
+check_load(Before, After) ->
+    lists:foreach(
+      fun({load, {Mod, _, _}}) ->
+	      case find_object_code(Mod, Before) of
+		  true -> ok;
+		  false -> throw({error, {no_object_code, Mod}})
+	      end;
+	 (_) -> ok
+      end, After).
+
+find_object_code(Mod, [{load_object_code, {_, _, Mods}} | T]) ->
+    case lists:member(Mod, Mods) of
+	true -> true;
+	false -> find_object_code(Mod, T)
+    end;
+find_object_code(Mod, [_|T]) ->
+    find_object_code(Mod, T);
+find_object_code(_Mod, []) ->
+    false.
+
+%%-----------------------------------------------------------------
+%% Checks that all suspended Mods are resumed, and that none are
+%% resumed/code_changed but not suspended.
+%%-----------------------------------------------------------------
+check_suspend_resume(Script) ->
+    Suspended   = lists:map(fun({Mod, _Timeout}) -> Mod;
+			       (Mod) -> Mod
+			    end,
+			    lists:flatten([X || {suspend, X} <- Script])),
+    Resumed = lists:flatten([X || {resume, X} <- Script]),
+    CodeChanged = lists:flatten([X || {code_change, _, {X, _}} <- Script]),
+    case difference(Suspended, Resumed) of
+	[] -> ok;
+	S2 -> throw({error, {suspended_not_resumed, S2}})
+    end,
+    case difference(Resumed, Suspended) of
+	[] -> ok;
+	R2 -> throw({error, {resumed_not_suspended, R2}})
+    end,
+    case difference(CodeChanged, Suspended) of
+	[] -> ok;
+	C2 -> throw({error, {code_change_not_suspended, C2}})
+    end.
+
+%%-----------------------------------------------------------------
+%% Checks that all stops are started, and that all starts are
+%% stopped.
+%%-----------------------------------------------------------------
+check_start_stop(Script) ->
+    Start = lists:flatten([X || {start, X} <- Script]),
+    Stop  = lists:flatten([X || {stop, X}  <- Script]),
+    case difference(Start, Stop) of
+	[] -> ok;
+	S2 -> throw({error, {start_not_stop, S2}})
+    end,
+    case difference(Stop, Start) of
+	[] -> ok;
+	S3 -> throw({error, {stop_not_start, S3}})
+    end.
+
+
+%%-----------------------------------------------------------------
+%% NORMALISATION
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Normalize those instructions that have variants (update and
+%% add_module).
+%%-----------------------------------------------------------------
+normalize_instrs(Script) ->
+    lists:map(fun({update, Mod, Change, PrePurge, PostPurge, Mods}) ->
+		      {update, Mod, dynamic, default, Change, PrePurge, 
+		       PostPurge, Mods};
+		 ({update, Mod, Timeout, Change, PrePurge, PostPurge, 
+		   Mods}) ->
+		      {update, Mod, dynamic, Timeout, Change, PrePurge, 
+		       PostPurge, Mods};
+		 ({add_module, Mod}) ->
+		      {add_module, Mod, []};
+		 (I) ->
+		      I
+	      end, Script).
+
+%%-----------------------------------------------------------------
+%% TRANSLATION OF INDEPENDENT INSTRUCTIONS
+%%-----------------------------------------------------------------
+
+%% translate_independent_instrs(Before, After, Appls, PreAppls) -> 
+%%						{NBefore, NAfter}
+%%
+translate_independent_instrs(Before, After, Appls, PreAppls) -> 
+    After1 = translate_application_instrs(After, Appls, PreAppls),
+    translate_add_module_instrs(Before, After1).
+
+%%-----------------------------------------------------------------
+%% Translates add_application, remove_application  and restart_application
+%% into add_module, remove, purge and apply.
+%%-----------------------------------------------------------------
+translate_application_instrs(Script, Appls, PreAppls) ->
+    %% io:format("Appls ~n~p~n",[Appls]),
+    L = lists:map(
+	  fun({add_application, Appl}) ->
+		  case lists:keysearch(Appl, #application.name, Appls) of
+		      {value, Application} ->
+			  Mods =
+			      remove_vsn(Application#application.modules),
+			  [{add_module, M, []} || M <- Mods] ++
+			      [{apply, {application, start,
+					[Appl, permanent]}}];
+		      false ->
+			  throw({error, {no_such_application, Appl}})
+		  end;
+
+	     ({remove_application, Appl}) ->
+		  case lists:keysearch(Appl, #application.name, Appls) of
+		      {value, _Application} ->
+			  throw({error, {removed_application_present,
+					 Appl}});
+		      false ->
+			  ignore
+		  end,
+		  case lists:keysearch(Appl, #application.name, PreAppls) of
+		      {value, RemApplication} ->
+			  Mods = remove_vsn(RemApplication#application.modules),
+			  [{apply, {application, stop, [Appl]}}] ++
+			      [{remove, {M, brutal_purge, brutal_purge}} || M <- Mods] ++
+			      [{purge, Mods},
+			       {apply, {application, unload, [Appl]}}];
+		      false ->
+			  throw({error, {no_such_application, Appl}})
+		  end;
+	     ({restart_application, Appl}) ->
+		  case lists:keysearch(Appl, #application.name, PreAppls) of
+		      {value, PreApplication} ->
+			  PreMods =
+			      remove_vsn(PreApplication#application.modules),
+
+			  case lists:keysearch(Appl, #application.name, Appls) of
+			      {value, PostApplication} ->
+				  PostMods =
+				      remove_vsn(PostApplication#application.modules),
+				  
+				  [{apply, {application, stop, [Appl]}}] ++
+				      [{remove, {M, brutal_purge, brutal_purge}} || M <- PreMods] ++
+				      [{purge, PreMods}] ++
+				      [{add_module, M, []} || M <- PostMods] ++
+				      [{apply, {application, start,
+						[Appl, permanent]}}];
+			      false ->
+				  throw({error, {no_such_application, Appl}})
+			  end;
+
+		      false ->
+			  throw({error, {no_such_application, Appl}})
+		  end;
+	     (X) -> X
+	  end, Script),
+    lists:flatten(L).
+
+remove_vsn(Mods) ->
+    lists:map(fun({Mod, _Vsn}) -> Mod;
+		 (Mod) -> Mod
+	      end, Mods).
+
+%%-----------------------------------------------------------------
+%% Translates add_module into load_module (high-level transformation)
+%%-----------------------------------------------------------------
+translate_add_module_instrs(Before, After) ->
+    NAfter = lists:map(
+	       fun({add_module, Mod, Mods}) -> 
+		       %% Purge method really doesn't matter. Module
+		       %% is new.
+		       {load_module, Mod, brutal_purge, brutal_purge, Mods};
+		  (I) ->
+		       I
+	       end, After),
+    {Before, NAfter}.
+		
+
+%%-----------------------------------------------------------------
+%% TRANSLATION OF INSTRUCTIONS WITH DEPENDENCIES
+%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Translates update, load_module and remove_module, and reorder the
+%% instructions according to dependencies. Leaves other instructions
+%% unchanged.
+%%-----------------------------------------------------------------
+translate_dependent_instrs(Mode, Before, After, Appls) ->
+    %% G is the total dependency graph, WCs is the decomposition of
+    %% the vertices (lists of vertices) of G. 
+    G = make_dependency_graph(After),
+    WCs = digraph_utils:components(G),
+    {NBefore, NAfter} = translate_dep_loop(G, WCs, After, Appls, 
+					   [], [], Mode),
+    digraph:delete(G),
+    {Before ++ NBefore, NAfter}.
+
+translate_dep_loop(G, WCs, [I| Is], Appls, Before, After, Mode) 
+  when is_tuple(I), size(I) > 1 ->
+    IName = element(1, I),
+    case lists:member(IName, ?DEP_INSTRS) of 
+	true ->
+	    Mod = element(2, I),
+	    DepIs = get_dependent_instructions(G, WCs, Mod),
+	    {B2, A2} = translate_dep_to_low(Mode, DepIs, Appls),
+	    RemIs = difference([I| Is], DepIs),
+	    translate_dep_loop(G, WCs, RemIs, Appls, Before ++ B2, 
+			       After ++ A2, Mode);
+	false ->
+	    translate_dep_loop(G, WCs, Is, Appls, Before, 
+			       After ++ [I], Mode)  % hmm
+    end;
+translate_dep_loop(G, WCs, [I| Is], Appls, Before, After, Mode) ->
+    translate_dep_loop(G, WCs, Is, Appls, Before, After ++ [I], Mode);  % hmm
+translate_dep_loop(_G, _WCs, [], _Appls, Before, After, _Mode) ->
+    {Before, After}.
+
+
+%%-----------------------------------------------------------------
+%% make_dependency_graph(Instructions) -> graph()
+%%
+%% The return value is a digraph graph(). A vertex is a module name
+%% Mod, and the associated data is {N, I} where I is the corresponding
+%% instruction, and N numbers the instruction in the order given at
+%% input. Only instructions that have dependencies are considered.
+%% %%-----------------------------------------------------------------
+make_dependency_graph(Instructions) ->
+    %% Filter out dependent instructions
+    DepIs = lists:filter(fun(I) when is_tuple(I) ->
+			       IName = element(1, I),
+			       lists:member(IName, ?DEP_INSTRS);
+			    (_) ->
+				 false
+			 end, Instructions),
+    {VDs, _} = lists:mapfoldl(
+			     fun(I, N) ->
+				     Mod = element(2, I),
+				     Mods = element(size(I), I),
+				     {{Mod, Mods, {N, I}}, N+1}
+			     end, 1, DepIs),
+    G = digraph:new(),
+    %% Add vertices
+    lists:foreach(
+      fun({Mod, _Mods, Data}) ->
+	      case digraph:vertex(G, Mod) of
+		  false ->
+		      digraph:add_vertex(G, Mod, Data);
+		  _  ->
+		      throw({error, {muldef_module, Mod}})
+	      end
+      end, VDs),
+    %% Add edges
+    lists:foreach(
+      fun({Mod, Mods, _Data}) ->
+	      lists:foreach(
+		fun(M) ->
+			case digraph:add_edge(G, Mod, M) of
+			    {error, _Reason} ->
+				throw({error, {undef_module, M}});
+			    _ ->
+				ok
+			end
+		end, Mods)
+      end, VDs),
+    G.
+
+%% get_dependent_instructions(G, WCs, Mod) -> DepIs
+%%  
+%% G is the global dependency graph, WCs are the weak components
+%% (lists of vertices) of G, and Mod is the module for which we will
+%% pick up all instructions that Mod depends on, or that depend on
+%% Mod.
+%%
+get_dependent_instructions(G, WCs, Mod) ->
+    case lists:filter(fun(C) -> lists:member(Mod, C) end, WCs) of
+	[WC] ->
+	    %% restrict G to WC
+	    H = restriction(WC, G),
+	    %% vertices of S are strong components of H
+	    S = condensation(H),
+	    Ts = digraph_utils:topsort(S),
+	    DepIss = lists:map(
+		       fun(T) -> 
+			       NIs = lists:map(
+				       fun(V) ->
+					       {_, Data} = 
+						   digraph:vertex(H, V),
+					       Data
+				       end, T),
+			       %% NIs = [{N, I}]
+			       SortedNIs = lists:keysort(1, NIs),
+			       lists:map(fun({_N, I}) -> I end, SortedNIs)
+		       end, Ts),
+	    DepIs = lists:flatten(DepIss),	% XXX One level flat only
+	    digraph:delete(H),
+	    digraph:delete(S),
+	    DepIs;
+	[] ->
+	    throw({error, {undef_module, Mod}});
+	_ -> 
+	    throw({error, {muldef_module, Mod}})
+    end.
+			       
+%% translate_dep_to_low(Mode, Instructions, Appls) -> {Before, After}
+%%
+%% Mode = up | dn
+%% Instructions are in order of dependency.
+%% Appls = [#application]
+%%
+%% Instructions translated are: update, load_module, and remove_module 
+%%
+%% Before =	[{load_object_code, ...}]
+%% After = 	[{suspend, ...}] ++ CodeInstrs ++ [{resume, ...}]
+%% CodeInstrs = [{load, ...}] ++ [{code_change, ...}]  (Mode == up)
+%% 	      = [{code_change, ...}] ++ [{load, ...}] ++
+%% 		[{code_change, ...}]  (Mode == dn)
+%%
+translate_dep_to_low(Mode, Instructions, Appls) ->
+    UpdateMods = 
+	filtermap(fun({update, Mod, _, default, _, _, _, _}) ->
+			  {true, Mod};
+		     ({update, Mod, _, T, _, _, _, _}) ->
+			  {true, {Mod, T}};
+		     (_) ->
+			  false
+		  end,
+		  Instructions),
+    RevUpdateMods = lists:reverse(UpdateMods),
+
+    %% Processes are suspended in the order of dependency.
+    SuspendInstrs =
+	if
+	    UpdateMods == [] -> [];
+	    true -> [{suspend, UpdateMods}]
+	end,
+
+
+    %% Processes are resumed in the reversed order of dependency.
+    ResumeInstrs =
+	if
+	    UpdateMods == [] -> [];
+	    true -> [{resume,
+		      lists:map(fun({Mod, _T}) -> Mod;
+				   (Mod) -> Mod
+				end, RevUpdateMods)}]
+	end,
+
+    LoadRemoveInstrs = 
+	filtermap(fun({update, Mod, _, _, _, PreP, PostP, _}) ->
+			  {true, {load, {Mod, PreP, PostP}}};
+		     ({load_module, Mod, PreP, PostP, _}) ->
+			  {true, {load, {Mod, PreP, PostP}}};
+		     ({remove_module, Mod, PreP, PostP, _}) ->
+			  {true, {remove, {Mod, PreP, PostP}}};
+		     (_) -> false
+		  end,
+		  Instructions),
+    RevLoadRemoveInstrs = lists:reverse(LoadRemoveInstrs),
+
+    %% The order of loading object code is unimportant. The order
+    %% chosen is the order of dependency.
+    LoadObjCodeInstrs = 
+	filtermap(fun({load, {Mod, _, _}}) ->
+		    {Lib, LibVsn} = get_lib(Mod, Appls),
+		    {true, {load_object_code, {Lib, LibVsn, [Mod]}}};
+		     (_) -> false
+	    end, LoadRemoveInstrs),
+    if
+	Mode == up ->
+	    %% The order of changing code is unimportant (processes
+	    %% are suspended). The order chosen is the order of
+	    %% dependency.
+	    CodeChangeMods = 
+		filtermap(fun({update, Mod, _, _,
+			       {advanced, Extra}, _, _, _}) ->
+				  {true, {Mod, Extra}};
+			     (_) ->
+				  false
+			  end, Instructions),
+	    CodeChangeInstrs = 
+		if
+		    CodeChangeMods == [] -> [];
+		    true -> [{code_change, up, CodeChangeMods}]
+		end,
+	    %% RevLoadRemoveInstrs: When upgrading modules are loaded
+	    %% in the reversed order of dependency.
+	    {LoadObjCodeInstrs, 
+	     SuspendInstrs ++ RevLoadRemoveInstrs ++ CodeChangeInstrs ++ 
+	     ResumeInstrs};
+
+	Mode == dn ->
+	    %% PreCodeChangeMods is the list of all modules that have
+	    %% to change code *before* the code is loaded (when
+	    %% downgrading). The order is not important (processes are
+	    %% suspended). The order chosen is the order of
+	    %% dependency.
+	    PreCodeChangeMods = 
+		[{Mod, Extra} ||
+		    {update, Mod, dynamic, _, {advanced, Extra}, _, _, _}
+			<- Instructions],
+	    PreCodeChangeInstrs = 
+		if
+		    PreCodeChangeMods == [] -> [];
+		    true -> [{code_change, down, PreCodeChangeMods}]
+		end,
+	    %% PostCodeChangeMods is the list of all modules that have
+	    %% to change code *after* the code is loaded (when
+	    %% downgrading). The order is not important (processes are
+	    %% suspended). The order chosen is the order of
+	    %% dependency.
+	    PostCodeChangeMods =
+		[{Mod, Extra} ||
+		    {update, Mod, static, _, {advanced, Extra}, _, _, _}
+			<- Instructions],
+	    PostCodeChangeInstrs = 
+		if
+		    PostCodeChangeMods == [] -> [];
+		    true -> [{code_change, down, PostCodeChangeMods}]
+		end,
+	    %% LoadRemoveInstrs: When downgrading modules are loaded
+	    %% in the order of dependency.
+	    {LoadObjCodeInstrs, 
+	     SuspendInstrs ++ PreCodeChangeInstrs ++
+	     LoadRemoveInstrs ++ PostCodeChangeInstrs ++ ResumeInstrs}
+    end.
+
+get_lib(Mod, [#application{name = Name, vsn = Vsn, modules = Modules} | T]) ->
+    %% Module = {Mod, Vsn} | Mod
+    case lists:keysearch(Mod, 1, Modules) of
+	{value, _} ->
+	    {Name, Vsn};
+	false ->
+	    case lists:member(Mod, Modules) of
+		true -> {Name, Vsn};
+		false ->   get_lib(Mod, T)
+	    end
+    end;
+get_lib(Mod, []) ->
+    throw({error, {no_such_module, Mod}}).
+
+%%-----------------------------------------------------------------
+%% MERGE LOAD_OBJECT_CODE
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Merge load_object_code instructions into one load_object_code 
+%% instruction per lib (optimization). Order is preserved. 
+%%-----------------------------------------------------------------
+merge_load_object_code(Before) ->
+    {Found, Rest} = split(fun({load_object_code, _}) -> true;
+			     (_) -> false
+			  end, Before),
+    mlo(Found) ++ Rest.
+
+mlo([{load_object_code, {Lib, LibVsn, Mods}} | T]) ->
+    {Same, Other} = split(fun({load_object_code, {Lib2, LibVsn2, _Mods2}})
+			       when Lib == Lib2, LibVsn == LibVsn2 -> true;
+			     ({load_object_code, {Lib2, LibVsn2, _Mods2}})
+			       when Lib == Lib2 ->
+				  throw({error, {conflicting_versions,
+						 Lib, LibVsn, LibVsn2}});
+			     (_) -> false
+			  end, T),
+    %% io:format("Same = ~p, Other = ~p~n", [Same, Other]),
+    %% foldr to preserver order.
+    OCode0 = lists:foldr(fun({load_object_code, {_, _, Ms}}, Res) ->
+				 U = union(Ms, Res),
+				 %% io:format("Ms = ~p, Res = ~p, U = ~p~n",
+				 %% [Ms, Res, U]),
+				 U
+			 end, [], Same),
+    OCode1 = union(Mods, OCode0),		% preserve order
+    %% io:format("OCode0 = ~p, OCode1 = ~p~n", [OCode0, OCode1]),
+    [{load_object_code, {Lib, LibVsn, OCode1}} | mlo(Other)];
+mlo([]) -> [].
+
+%%-----------------------------------------------------------------
+%% SYNTAX CHECK
+%%-----------------------------------------------------------------
+%%-----------------------------------------------------------------
+%% Checks the syntax of all instructions.
+%%-----------------------------------------------------------------
+check_syntax([H|T]) ->
+    check_op(H),
+    check_syntax(T);
+check_syntax([]) -> ok.
+
+check_op(mnesia_backup) ->
+    throw({error, {not_yet_implemented, mnesia_backup}});
+check_op({update, Mod, Change, PrePurge, PostPurge, Mods}) ->
+    check_mod(Mod),
+    check_change(Change),
+    check_purge(PrePurge),
+    check_purge(PostPurge),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({update, Mod, Timeout, Change, PrePurge, PostPurge, Mods}) ->
+    check_mod(Mod),
+    check_timeout(Timeout),
+    check_change(Change),
+    check_purge(PrePurge),
+    check_purge(PostPurge),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({update, Mod, ModType, Timeout, Change, PrePurge, PostPurge, 
+	  Mods}) ->
+    check_mod(Mod),
+    check_mod_type(ModType),
+    check_timeout(Timeout),
+    check_change(Change),
+    check_purge(PrePurge),
+    check_purge(PostPurge),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({load_module, Mod, PrePurge, PostPurge, Mods}) ->
+    check_mod(Mod),
+    check_purge(PrePurge),
+    check_purge(PostPurge),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({add_module, Mod}) ->
+    check_mod(Mod);
+check_op({add_module, Mod, Mods}) ->
+    check_mod(Mod),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({remove_module, Mod, PrePurge, PostPurge, Mods}) ->
+    check_mod(Mod),
+    check_purge(PrePurge),
+    check_purge(PostPurge),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({remove_application, Appl}) ->
+    check_appl(Appl);
+check_op({add_application, Appl}) ->
+    check_appl(Appl);
+check_op({restart_application, Appl}) ->
+    check_appl(Appl);
+check_op(restart) -> ok;
+check_op(reboot) -> ok;
+check_op({load_object_code, {Lib, LibVsn, Mods}}) ->
+    check_lib(Lib),
+    check_lib_vsn(LibVsn),
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op(point_of_no_return) -> ok;
+check_op({load, {Mod, PrePurge, PostPurge}}) ->
+    check_mod(Mod),
+    check_purge(PrePurge),
+    check_purge(PostPurge);
+check_op({remove, {Mod, PrePurge, PostPurge}}) ->
+    check_mod(Mod),
+    check_purge(PrePurge),
+    check_purge(PostPurge);
+check_op({purge, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({suspend, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun({M,T}) -> check_mod(M), check_timeout(T);
+		     (M) -> check_mod(M)
+		  end, Mods);
+check_op({resume, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({code_change, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun({M, _Extra}) -> check_mod(M);
+		     (X) -> throw({error, {bad_code_change, X}})
+		  end, Mods);
+check_op({code_change, Mode, Mods}) ->
+    check_list(Mods),
+    check_mode(Mode),
+    lists:foreach(fun({M, _Extra}) -> check_mod(M);
+		     (X) -> throw({error, {bad_code_change, X}})
+		  end, Mods);
+check_op({stop, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({start, Mods}) ->
+    check_list(Mods),
+    lists:foreach(fun(M) -> check_mod(M) end, Mods);
+check_op({sync_nodes, _Id, {M, F, A}}) ->
+    check_mod(M),
+    check_func(F),
+    check_args(A);
+check_op({sync_nodes, _Id, Nodes}) ->
+    check_list(Nodes),
+    lists:foreach(fun(Node) -> check_node(Node) end, Nodes);
+check_op({apply, {M, F, A}}) ->
+    check_mod(M),
+    check_func(F),
+    check_args(A);
+check_op(restart_new_emulator) -> ok;
+check_op(X) -> throw({error, {bad_instruction, X}}).
+
+check_mod(Mod) when is_atom(Mod) -> ok;
+check_mod(Mod) -> throw({error, {bad_module, Mod}}).
+
+check_change(soft) -> ok;
+check_change({advanced, _}) -> ok;
+check_change(Change) -> throw({error, {bad_change, Change}}).
+
+check_mod_type(static) -> ok;
+check_mod_type(dynamic) -> ok;
+check_mod_type(ModType) -> throw({error, {bad_mod_type, ModType}}).
+
+check_purge(soft_purge) -> ok;
+check_purge(brutal_purge) -> ok;
+check_purge(Purge) -> throw({error, {bad_purge_method, Purge}}).
+
+check_list(List) when is_list(List) -> ok;
+check_list(List) -> throw({error, {bad_list, List}}).
+
+check_args(Args) when is_list(Args) -> ok;
+check_args(Args) -> throw({error, {bad_args_list, Args}}).
+
+check_node(Node) when is_atom(Node) -> ok;
+check_node(Node) -> throw({error, {bad_node, Node}}).
+
+check_appl(Appl) when is_atom(Appl) -> ok;
+check_appl(Appl) -> throw({error, {bad_application, Appl}}).
+
+check_func(Func) when is_atom(Func) -> ok;
+check_func(Func) -> throw({error, {bad_func, Func}}).
+
+check_lib(Lib) when is_atom(Lib) -> ok;
+check_lib(Lib) -> throw({error, {bad_lib, Lib}}).
+
+check_lib_vsn(LibVsn) when is_list(LibVsn) -> ok;
+check_lib_vsn(LibVsn) -> throw({error, {bad_lib_vsn, LibVsn}}).
+
+check_timeout(default) -> ok;
+check_timeout(infinity) -> ok;
+check_timeout(Int) when is_integer(Int), Int > 0 -> ok;
+check_timeout(T) -> throw({error, {bad_timeout, T}}).
+
+check_mode(up) -> ok;
+check_mode(down) -> ok;
+check_mode(Mode) -> throw({error, {bad_mode, Mode}}).
+
+%%-----------------------------------------------------------------
+%% Format error
+%%-----------------------------------------------------------------
+format_error({bad_op_before_point_of_no_return, Instruction}) ->
+    io_lib:format("Bad instruction ~p~nbefore point_of_no_return~n",
+		  [Instruction]);
+format_error({no_object_code, Mod}) ->
+    io_lib:format("No load_object_code found for module: ~p~n", [Mod]);
+format_error({suspended_not_resumed, Mods}) ->
+    io_lib:format("Suspended but not resumed: ~p~n", [Mods]);
+format_error({resumed_not_suspended, Mods}) ->
+    io_lib:format("Resumed but not suspended: ~p~n", [Mods]);
+format_error({code_change_not_suspended, Mods}) ->
+    io_lib:format("Code changed but not suspended: ~p~n", [Mods]);
+format_error({start_not_stop, Mods}) ->
+    io_lib:format("Started but not stopped: ~p~n", [Mods]);
+format_error({stop_not_start, Mods}) ->
+    io_lib:format("Stopped but not started: ~p~n", [Mods]);
+format_error({no_such_application, App}) ->
+    io_lib:format("Started undefined application: ~p~n", [App]);
+format_error({removed_application_present, App}) ->
+    io_lib:format("Removed application present: ~p~n", [App]);
+format_error(dup_mnesia_backup) ->
+    io_lib:format("Duplicate mnesia_backup~n", []);
+format_error(bad_mnesia_backup) ->
+    io_lib:format("mnesia_backup in bad position~n", []);
+format_error({conflicting_versions, Lib, V1, V2}) ->
+    io_lib:format("Conflicting versions for ~p, ~p and ~p~n", [Lib, V1, V2]);
+format_error({no_appl_vsn, Appl}) ->
+    io_lib:format("No version specified for application: ~p~n", [Appl]);
+format_error({no_such_module, Mod}) ->
+    io_lib:format("No such module: ~p~n", [Mod]);
+format_error(too_many_point_of_no_return) ->
+    io_lib:format("Too many point_of_no_return~n", []);
+
+format_error({bad_instruction, X}) ->
+    io_lib:format("Bad instruction: ~p~n", [X]);
+format_error({bad_module, X}) ->
+    io_lib:format("Bad module: ~p(should be atom())~n", [X]);
+format_error({bad_code_change, X}) ->
+    io_lib:format("Bad code_change: ~p(should be {Mod, Extra})~n", [X]);
+format_error({bad_change, X}) ->
+    io_lib:format("Bad change spec: ~p(should be soft | {advanced, E})~n", [X]);
+format_error({bad_mod_type, X}) ->
+    io_lib:format("Bad module type: ~p(should be static | dynamic)~n", [X]);
+format_error({bad_purge_method, X}) ->
+    io_lib:format("Bad purge method: ~p(should be soft_purge | brutal_purge)~n",
+		  [X]);
+format_error({bad_list, X}) ->
+    io_lib:format("Bad list: ~p~n", [X]);
+format_error({bad_args_list, X}) ->
+    io_lib:format("Bad argument list: ~p~n", [X]);
+format_error({bad_node, X}) ->
+    io_lib:format("Bad node: ~p(should be atom())~n", [X]);
+format_error({bad_application, X}) ->
+    io_lib:format("Bad application: ~p(should be atom())~n", [X]);
+format_error({bad_func, X}) ->
+    io_lib:format("Bad function: ~p(should be atom())~n", [X]);
+format_error({bad_lib, X}) ->
+    io_lib:format("Bad library: ~p(should be atom())~n", [X]);
+format_error({bad_lib_vsn, X}) ->
+    io_lib:format("Bad library version: ~p(should be string())~n", [X]);
+format_error({bad_timeout, X}) ->
+    io_lib:format("Bad timeout: ~p(should be infinity | int() > 0)~n", [X]);
+
+format_error({undef_module, Mod}) ->
+    io_lib:format("Undefined module: ~p~n", [Mod]);
+format_error({muldef_module, Mod}) ->
+    io_lib:format("Multiply defined module: ~p~n", [Mod]);
+format_error(E) ->
+    io_lib:format("~p~n",[E]).
+
+
+%%-----------------------------------------------------------------
+%% MISC SUPPORT
+%%-----------------------------------------------------------------
+
+%% filtermap(F, List1) -> List2
+%% F(H) -> false | true | {true, Val}
+filtermap(F, List) ->
+    lists:zf(F, List).
+
+%% split(F, List1) -> {List2, List3}
+%% F(H) -> true | false. Preserves order. 
+split(Fun, [H | T]) ->
+    {Found, Rest} = split(Fun, T),
+    case Fun(H) of
+	true -> {[H | Found], Rest};
+	false -> {Found, [H | Rest]}
+    end;
+split(_Fun, []) ->
+    {[], []}.
+
+union([H|T], L) ->
+    case lists:member(H, L) of
+	true -> union(T,L);
+	false -> [H | union(T, L)]
+    end;
+union([], L) -> L.
+
+difference([H | T], L) ->
+    case lists:member(H, L) of
+	true -> difference(T, L);
+	false -> [H | difference(T, L)]
+    end;
+difference([], _) -> [].
+
+
+%%-----------------------------------------------------------------
+%% GRAPHS
+%%-----------------------------------------------------------------
+
+%% Additions to digraph and digraph utils.
+%% XXX Should be removed in future versions.
+
+%% This function should be included in digraph_utils.
+
+%% condensation(G) -> graph()
+%% 
+%% Given a graph G, returns a new graph H where each vertex V in H is
+%% a strong component of G, and where there is an edge from V1 to V2
+%% in H if there are members of v1 and v2 of V1 and V2, respectively,
+%% such that there is an edge from v1 to v2 in G.
+%%
+condensation(G) ->
+    H = digraph:new(),
+    HVs = digraph_utils:strong_components(G),
+    %% Add all vertices
+    lists:foreach(fun(HV) -> digraph:add_vertex(H, HV) end, HVs),
+    %% Add edges
+    lists:foreach(
+      fun(HV1) ->
+	      GRs = digraph_utils:reachable(HV1, G),
+	      lists:foreach(
+		fun(HV2) ->
+			if
+			    HV1 /= HV2 ->
+				case lists:member(hd(HV2), GRs) of
+				    true ->
+					digraph:add_edge(H, HV1, HV2);
+				    _  ->
+					ok
+				end;
+			    true  ->
+				ok 
+			end
+		end, HVs)
+      end,  HVs),
+    H.
+
+
+%% This function should be included in digraph.
+
+%% restriction(Rs, G) -> graph()
+%% 
+%% Given a graph G, returns a new graph H that is the restriction of
+%% G to the vertices Rs. 
+%%
+restriction(Rs, G) ->
+    H = digraph:new(),
+    %% Add vertices
+    lists:foreach(
+      fun(R) ->
+	      case digraph:vertex(G, R) of
+		  {R, Data} ->
+		      digraph:add_vertex(H, R, Data);
+		  _  ->
+		      ok
+	      end
+      end, Rs),
+    %% Add edges
+    GEs = digraph:edges(G),
+    lists:foreach(
+      fun(GE) ->
+	      {_, GV1, GV2, GData} = digraph:edge(G, GE),
+	      case {digraph:vertex(H, GV1), digraph:vertex(H, GV2)} of
+		  {{GV1, _}, {GV2, _}} ->
+		      digraph:add_edge(H, GE, GV1, GV2, GData);
+		  _  ->
+		      ok
+	      end
+      end, GEs),
+    H.
+
+