[m-rev.] for review: module initialisation for erlang

Peter Wang wangp at students.csse.unimelb.edu.au
Thu Jun 7 12:46:29 AEST 2007


Estimated hours taken: 10
Branches: main

Support :- initialise and :- finalise predicates in the Erlang backend.

compiler/compile_target_code.m:
	Refactor the code relating to running mkinit to generate .init and
	_init.c files, and compiling _init.c files.
	
	Generalise the code so that it can call mkinit_erl with the right
	options.

compiler/dead_proc_elim.m:
	Add initialisation and finalisation predicates to the queue at the
	start of the pass so that they won't be eliminated.  For the C
	backends we implicitly :- foreign_export init and final preds so they
	would never be eliminated, but we don't do that in the Erlang
	backend.

compiler/elds.m:
	Extend the ELDS to hold pred_proc_ids of init/final preds.

compiler/erl_code_gen.m:
compiler/mercury_compile.m:
	Conform to change in ELDS.

compiler/elds_to_erlang.m:
	Output mercury__required_init and mercury__required_final functions
	which call user initialisation and finalisation predicates, if any.

	Write out -export annotations for those functions.

	Write out REQUIRED_INIT and REQUIRED_FINAL directives for those
	functions.

compiler/hlds_module.m:
compiler/make_hlds_passes.m:
	Remember the arity of init/final preds in the HLDS, not just the
	sym_name.

	Add predicates to return the pred_proc_ids of init/final preds.

	Delete module_info_user_init_pred_c_name and
	module_info_user_final_pred_c_name as they are unused.

compiler/make.program_target.m:
	Call make_erlang_program_init_file and make_erlang_library_init_file
	when building an Erlang executable or library, respectively.

	Install a .init file when installing an Erlang library.

	Conform to changes in compile_target_code.m.

compiler/modules.m:
	In module_name_to_file_name, treat extensions specially if they end
	".erl" and ".beam", not only if they are exactly those strings.  This
	is because we may pass "_init.erl" or "_init.beam" as the extension.

compiler/options.m:
	Add an option `--mkinit-erl-command'.

util/Mmakefile:
util/.cvsignore:
util/mkinit_erl.c:
	Add `mkinit_erl' program which is a modified version of `mkinit'.

util/mkinit.c:
	Make `mkinit' accept and ignore the `-m' option, which is needed by
	`mkinit_erl'.

tests/hard_coded/Mmakefile:
	Fix misspellings of "MERCURY_SUPPRESS_STACK_TRACE".

tests/hard_coded/impure_init_and_final.m:
	Add Erlang foreign proc.


Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.108
diff -u -r1.108 compile_target_code.m
--- compiler/compile_target_code.m	30 May 2007 05:15:03 -0000	1.108
+++ compiler/compile_target_code.m	7 Jun 2007 02:41:37 -0000
@@ -85,11 +85,21 @@
 :- pred compile_erlang_file(io.output_stream::in, file_name::in,
     bool::out, io::di, io::uo) is det.
 
-    % make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded):
+    % make_library_init_file(ErrorStream, MainModuleName, ModuleNames,
+    %   Succeeded):
     %
     % Make the `.init' file for a library containing the given modules.
     %
-:- pred make_init_file(io.output_stream::in, module_name::in,
+:- pred make_library_init_file(io.output_stream::in, module_name::in,
+    list(module_name)::in, bool::out, io::di, io::uo) is det.
+
+    % make_init_erlang_library(ErrorStream, MainModuleName, ModuleNames,
+    %   Succeeded):
+    %
+    % Make the `.init' file for an Erlang library containing the given
+    % modules.
+    %
+:- pred make_erlang_library_init_file(io.output_stream::in, module_name::in,
     list(module_name)::in, bool::out, io::di, io::uo) is det.
 
     % make_init_obj_file(ErrorStream, MainModuleName, AllModuleNames,
@@ -98,6 +108,12 @@
 :- pred make_init_obj_file(io.output_stream::in, module_name::in,
     list(module_name)::in, maybe(file_name)::out, io::di, io::uo) is det.
 
+    % make_erlang_program_init_file(ErrorStream, MainModuleName,
+    %   AllModuleNames, MaybeInitObjFileName)
+    %
+:- pred make_erlang_program_init_file(io.output_stream::in, module_name::in,
+    list(module_name)::in, maybe(file_name)::out, io::di, io::uo) is det.
+
 :- type linked_target_type
     --->    executable
     ;       static_library
@@ -945,25 +961,35 @@
 
 %-----------------------------------------------------------------------------%
 
-make_init_file(ErrorStream, MainModuleName, AllModules, Succeeded, !IO) :-
+make_library_init_file(ErrorStream, MainModuleName, AllModules, Succeeded,
+        !IO) :-
+    globals.io_lookup_string_option(mkinit_command, MkInit, !IO),
+    make_library_init_file_2(ErrorStream, MainModuleName, AllModules, ".c",
+        MkInit, Succeeded, !IO).
+
+make_erlang_library_init_file(ErrorStream, MainModuleName, AllModules,
+        Succeeded, !IO) :-
+    globals.io_lookup_string_option(mkinit_erl_command, MkInit, !IO),
+    make_library_init_file_2(ErrorStream, MainModuleName, AllModules, ".erl",
+        MkInit, Succeeded, !IO).
+
+:- pred make_library_init_file_2(io.output_stream::in, module_name::in,
+    list(module_name)::in, string::in, string::in,
+    bool::out, io::di, io::uo) is det.
+
+make_library_init_file_2(ErrorStream, MainModuleName, AllModules, TargetExt,
+        MkInit, Succeeded, !IO) :-
     module_name_to_file_name(MainModuleName, ".init.tmp", yes, TmpInitFileName,
         !IO),
     io.open_output(TmpInitFileName, InitFileRes, !IO),
     (
         InitFileRes = ok(InitFileStream),
-        ModuleNameToCFileName =
-            (pred(ThisModule::in, CFileName::out, !.IO::di, !:IO::uo) is det :-
-                module_name_to_file_name(ThisModule, ".c", no, CFileName, !IO)
-        ),
-        list.map_foldl(ModuleNameToCFileName, AllModules, AllCFilesList, !IO),
-        join_quoted_string_list(AllCFilesList, "", "", " ", CFileNames),
+        list.map_foldl(module_name_to_file_name_ext(TargetExt, no),
+            AllModules, AllTargetFilesList, !IO),
+        join_quoted_string_list(AllTargetFilesList, "", "", " ",
+            TargetFileNames),
         
-        globals.io_lookup_string_option(mkinit_command, MkInit, !IO),
-        MkInitCmd = string.append_list(
-            [   MkInit,
-                " -k ",
-                " ", CFileNames
-            ]),
+        MkInitCmd = string.append_list([MkInit, " -k ", TargetFileNames]),
         invoke_system_command(InitFileStream, cmd_verbose, MkInitCmd, MkInitOK,
             !IO),
        
@@ -1033,6 +1059,12 @@
         Succeeded = no
     ).
 
+:- pred module_name_to_file_name_ext(string::in, bool::in, module_name::in, 
+    file_name::out, io::di, io::uo) is det.
+
+module_name_to_file_name_ext(Ext, MkDir, ModuleName, FileName, !IO) :-
+    module_name_to_file_name(ModuleName, Ext, MkDir, FileName, !IO).
+
 %-----------------------------------------------------------------------------%
 
 link_module_list(Modules, FactTableObjFiles, Succeeded, !IO) :-
@@ -1111,6 +1143,8 @@
         Succeeded = no
     ).
 
+%-----------------------------------------------------------------------------%
+
 make_init_obj_file(ErrorStream, ModuleName, ModuleNames, Result, !IO) :-
     globals.io_lookup_bool_option(rebuild, MustCompile, !IO),
     make_init_obj_file(ErrorStream, MustCompile, ModuleName, ModuleNames,
@@ -1126,6 +1160,91 @@
 
 make_init_obj_file(ErrorStream, MustCompile, ModuleName, ModuleNames, Result,
         !IO) :-
+    globals.io_lookup_maybe_string_option(
+        mercury_standard_library_directory, MaybeStdLibDir, !IO),
+    globals.io_get_globals(Globals, !IO),
+    grade_directory_component(Globals, GradeDir),
+    (
+        MaybeStdLibDir = yes(StdLibDir),
+        ToGradeInit = (func(File) = StdLibDir / "modules" / GradeDir / File),
+        StdInitFileNames = [
+            ToGradeInit("mer_rt.init"),
+            ToGradeInit("mer_std.init")
+        ],
+        StdTraceInitFileNames = [
+            ToGradeInit("mer_browser.init"),
+            ToGradeInit("mer_mdbcomp.init")
+        ]
+    ;
+        MaybeStdLibDir = no,
+        StdInitFileNames = [],
+        StdTraceInitFileNames = []
+    ),
+
+    globals.io_lookup_string_option(mkinit_command, MkInit, !IO),
+    make_init_target_file(ErrorStream, MkInit, ModuleName, ModuleNames, ".c",
+        StdInitFileNames, StdTraceInitFileNames, "", MaybeInitTargetFile, !IO),
+
+    get_object_code_type(executable, PIC, !IO),
+    maybe_pic_object_file_extension(PIC, ObjExt, !IO),
+
+    module_name_to_file_name(ModuleName, "_init" ++ ObjExt, yes,
+        InitObjFileName, !IO),
+    CompileCInitFile =
+        (pred(InitTargetFileName::in, Res::out, IO0::di, IO::uo) is det :-
+            compile_c_file(ErrorStream, PIC, InitTargetFileName,
+                InitObjFileName, Res, IO0, IO)
+        ),
+    maybe_compile_init_obj_file(MaybeInitTargetFile, MustCompile,
+        CompileCInitFile, InitObjFileName, Result, !IO).
+
+make_erlang_program_init_file(ErrorStream, ModuleName, ModuleNames, Result,
+        !IO) :-
+    globals.io_lookup_bool_option(rebuild, MustCompile, !IO),
+
+    globals.io_lookup_maybe_string_option(
+        mercury_standard_library_directory, MaybeStdLibDir, !IO),
+    globals.io_get_globals(Globals, !IO),
+    grade_directory_component(Globals, GradeDir),
+    (
+        MaybeStdLibDir = yes(StdLibDir),
+        StdInitFileNames = [
+            StdLibDir / "modules" / GradeDir / "mer_std.init"
+        ]
+    ;
+        MaybeStdLibDir = no,
+        StdInitFileNames = []
+    ),
+    % Tracing is not supported in Erlang backend.
+    StdTraceInitFileNames = [],
+
+    % We need to pass the module name to mkinit_erl.
+    ErlangModuleName = erlang_module_name(ModuleName),
+    ModuleNameStr = sym_name_to_string_sep(ErlangModuleName, "__") ++ "_init",
+    ModuleNameOption = " -m " ++ quote_arg(ModuleNameStr),
+
+    globals.io_lookup_string_option(mkinit_erl_command, MkInitErl, !IO),
+    make_init_target_file(ErrorStream, MkInitErl, ModuleName, ModuleNames, ".erl",
+        StdInitFileNames, StdTraceInitFileNames, ModuleNameOption,
+        MaybeInitTargetFile, !IO),
+
+    module_name_to_file_name(ModuleName, "_init.beam", yes,
+        InitObjFileName, !IO),
+    CompileErlangInitFile =
+        (pred(InitTargetFileName::in, Res::out, IO0::di, IO::uo) is det :-
+            compile_erlang_file(ErrorStream, InitTargetFileName, Res, IO0, IO)
+        ),
+    maybe_compile_init_obj_file(MaybeInitTargetFile, MustCompile,
+        CompileErlangInitFile, InitObjFileName, Result, !IO).
+
+:- pred make_init_target_file(io.output_stream::in, string::in,
+    module_name::in, list(module_name)::in, string::in,
+    list(file_name)::in, list(file_name)::in, string::in,
+    maybe(file_name)::out, io::di, io::uo) is det.
+
+make_init_target_file(ErrorStream, MkInit, ModuleName, ModuleNames, TargetExt,
+        StdInitFileNames, StdTraceInitFileNames, ModuleNameOption,
+        MaybeInitTargetFile, !IO) :-
     globals.io_lookup_bool_option(verbose, Verbose, !IO),
     globals.io_lookup_bool_option(statistics, Stats, !IO),
     maybe_write_string(Verbose, "% Creating initialization file...\n", !IO),
@@ -1133,18 +1252,12 @@
     globals.io_get_globals(Globals, !IO),
     compute_grade(Globals, Grade),
 
-    get_object_code_type(executable, PIC, !IO),
-    maybe_pic_object_file_extension(PIC, ObjExt, !IO),
-    InitObj = "_init" ++ ObjExt,
+    module_name_to_file_name(ModuleName, "_init" ++ TargetExt, yes,
+        InitTargetFileName, !IO),
 
-    module_name_to_file_name(ModuleName, "_init.c", yes, InitCFileName, !IO),
-    module_name_to_file_name(ModuleName, InitObj, yes, InitObjFileName, !IO),
-
-    list.map_foldl(
-        (pred(ThisModule::in, CFileName::out, IO0::di, IO::uo) is det :-
-            module_name_to_file_name(ThisModule, ".c", no, CFileName, IO0, IO)
-        ), ModuleNames, CFileNameList, !IO),
-    join_quoted_string_list(CFileNameList, "", "", " ", CFileNames),
+    list.map_foldl(module_name_to_file_name_ext(TargetExt, no),
+        ModuleNames, TargetFileNameList, !IO),
+    join_quoted_string_list(TargetFileNameList, "", "", " ", TargetFileNames),
 
     globals.io_lookup_accumulating_option(init_file_directories,
         InitFileDirsList, !IO),
@@ -1154,26 +1267,8 @@
         !IO),
     globals.io_lookup_accumulating_option(trace_init_files,
         TraceInitFileNamesList0, !IO),
-    globals.io_lookup_maybe_string_option(
-        mercury_standard_library_directory, MaybeStdLibDir, !IO),
-    grade_directory_component(Globals, GradeDir),
-    (
-        MaybeStdLibDir = yes(StdLibDir),
-        InitFileNamesList1 = [
-            StdLibDir / "modules" / GradeDir / "mer_rt.init",
-            StdLibDir / "modules" / GradeDir / "mer_std.init" |
-            InitFileNamesList0
-        ],
-        TraceInitFileNamesList = [
-            StdLibDir/"modules"/ GradeDir / "mer_browser.init",
-            StdLibDir/"modules"/ GradeDir / "mer_mdbcomp.init" |
-            TraceInitFileNamesList0
-        ]
-    ;
-        MaybeStdLibDir = no,
-        InitFileNamesList1 = InitFileNamesList0,
-        TraceInitFileNamesList = TraceInitFileNamesList0
-    ),
+    InitFileNamesList1 = StdInitFileNames ++ InitFileNamesList0,
+    TraceInitFileNamesList = StdTraceInitFileNames ++ TraceInitFileNamesList0,
 
     globals.io_get_trace_level(TraceLevel, !IO),
     ( given_trace_level_is_none(TraceLevel) = no ->
@@ -1204,78 +1299,111 @@
         ExperimentalComplexityOpt = "-X " ++ ExperimentalComplexity
     ),
 
-    globals.io_lookup_string_option(mkinit_command, Mkinit, !IO),
-    TmpInitCFileName = InitCFileName ++ ".tmp",
+    TmpInitTargetFileName = InitTargetFileName ++ ".tmp",
     MkInitCmd = string.append_list(
-        [   Mkinit,
+        [   MkInit,
             " -g ", Grade,
             " ", TraceOpt,
             " ", ExtraInitsOpt,
             " ", NoMainOpt,
             " ", ExperimentalComplexityOpt,
             " ", RuntimeFlags,
-            " -o ", quote_arg(TmpInitCFileName),
+            " -o ", quote_arg(TmpInitTargetFileName),
             " ", InitFileDirs,
             " ", InitFileNames, 
-            " ", CFileNames
+            " ", TargetFileNames,
+            ModuleNameOption
         ]),
-    invoke_system_command(ErrorStream, cmd_verbose, MkInitCmd, MkInitOK0, !IO),
+    invoke_system_command(ErrorStream, cmd_verbose, MkInitCmd, MkInitOk, !IO),
     maybe_report_stats(Stats, !IO),
     (
-        MkInitOK0 = yes,
-        update_interface_return_succeeded(InitCFileName, MkInitOK1, !IO),
+        MkInitOk = yes,
+        update_interface_return_succeeded(InitTargetFileName, UpdateOk, !IO),
         (
-            MkInitOK1 = yes,
-            (
-                MustCompile = yes,
-                Compile = yes
-            ;
-                MustCompile = no,
-                io.file_modification_time(InitCFileName,
-                    InitCModTimeResult, !IO),
-                io.file_modification_time(InitObjFileName,
-                    InitObjModTimeResult, !IO),
-                (
-                    InitObjModTimeResult = ok(InitObjModTime),
-                    InitCModTimeResult = ok(InitCModTime),
-                    compare(TimeCompare, InitObjModTime, InitCModTime),
-                    ( TimeCompare = (=)
-                    ; TimeCompare = (>)
-                    )
-                ->
-                    Compile = no
-                ;
-                    Compile = yes
-                )
-            ),
-            (
-                Compile = yes,
-                maybe_write_string(Verbose,
-                "% Compiling initialization file...\n", !IO),
+            UpdateOk = yes,
+            MaybeInitTargetFile = yes(InitTargetFileName)
+        ;
+            UpdateOk = no,
+            MaybeInitTargetFile = no
+        )
+    ;
+        MkInitOk = no,
+        MaybeInitTargetFile = no
+    ).
 
-                compile_c_file(ErrorStream, PIC, InitCFileName,
-                    InitObjFileName, CompileOK, !IO),
-                maybe_report_stats(Stats, !IO),
-                (
-                    CompileOK = no,
-                    Result = no
-                ;
-                    CompileOK = yes,
-                    Result = yes(InitObjFileName)
-                )
-            ;
-                Compile = no,
+:- pred maybe_compile_init_obj_file(maybe(file_name)::in, bool::in,
+    compile_init_file_pred::in(compile_init_file_pred),
+    file_name::in, maybe(file_name)::out, io::di, io::uo) is det.
+
+:- type compile_init_file_pred == pred(file_name, bool, io, io).
+:- inst compile_init_file_pred == (pred(in, out, di, uo) is det).
+
+maybe_compile_init_obj_file(MaybeInitTargetFile, MustCompile, Compile,
+        InitObjFileName, Result, !IO) :-
+    globals.io_lookup_bool_option(verbose, Verbose, !IO),
+    globals.io_lookup_bool_option(statistics, Stats, !IO),
+    (
+        MaybeInitTargetFile = yes(InitTargetFileName),
+        file_as_new_as(InitTargetFileName, InitObjFileName, UpToDate, !IO),
+        (
+            ( MustCompile = yes
+            ; UpToDate = no
+            )
+        ->
+            maybe_write_string(Verbose,
+                "% Compiling initialization file...\n", !IO),
+            Compile(InitTargetFileName, CompileOk, !IO),
+            maybe_report_stats(Stats, !IO),
+            (
+                CompileOk = yes,
                 Result = yes(InitObjFileName)
+            ;
+                CompileOk = no,
+                Result = no
             )
         ;
-            MkInitOK1 = no,
-            Result = no
+            Result = yes(InitObjFileName)
         )
     ;
-        MkInitOK0 = no,
+        MaybeInitTargetFile = no,
         Result = no
     ).
 
+:- pred file_as_new_as(file_name::in, file_name::in, bool::out,
+    io::di, io::uo) is det.
+
+file_as_new_as(FileNameA, FileNameB, IsAsNew, !IO) :-
+    compare_file_timestamps(FileNameA, FileNameB, MaybeCompare, !IO),
+    (
+        ( MaybeCompare = yes(=)
+        ; MaybeCompare = yes(>)
+        ),
+        IsAsNew = yes
+    ;
+        ( MaybeCompare = yes(<)
+        ; MaybeCompare = no
+        ),
+        IsAsNew = no
+    ).
+
+:- pred compare_file_timestamps(file_name::in, file_name::in,
+    maybe(comparison_result)::out, io::di, io::uo) is det.
+
+compare_file_timestamps(FileNameA, FileNameB, MaybeCompare, !IO) :-
+    io.file_modification_time(FileNameA, TimeResultA, !IO),
+    io.file_modification_time(FileNameB, TimeResultB, !IO),
+    (
+        TimeResultA = ok(TimeA),
+        TimeResultB = ok(TimeB)
+    ->
+        compare(Compare, TimeA, TimeB),
+        MaybeCompare = yes(Compare)
+    ;
+        MaybeCompare = no
+    ).
+
+%-----------------------------------------------------------------------------%
+
 % WARNING: The code here duplicates the functionality of scripts/ml.in.
 % Any changes there may also require changes here, and vice versa.
 
@@ -1821,13 +1949,8 @@
     is det.
 
 same_timestamp(FileNameA, FileNameB, SameTimestamp, !IO) :-
-    io.file_modification_time(FileNameA, TimestampResultA, !IO),
-    io.file_modification_time(FileNameB, TimestampResultB, !IO),
-    (
-        TimestampResultA = ok(TimestampA),
-        TimestampResultB = ok(TimestampB),
-        time_t_to_timestamp(TimestampA) = time_t_to_timestamp(TimestampB)
-    ->
+    compare_file_timestamps(FileNameA, FileNameB, MaybeCompare, !IO),
+    ( MaybeCompare = yes(=) ->
         SameTimestamp = yes
     ;
         SameTimestamp = no
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.121
diff -u -r1.121 dead_proc_elim.m
--- compiler/dead_proc_elim.m	17 May 2007 03:52:40 -0000	1.121
+++ compiler/dead_proc_elim.m	7 Jun 2007 02:41:37 -0000
@@ -146,10 +146,19 @@
     module_info_predids(PredIds, !ModuleInfo),
     module_info_preds(!.ModuleInfo, PredTable),
     dead_proc_initialize_preds(PredIds, PredTable, !Queue, !Needed),
+
     module_info_get_pragma_exported_procs(!.ModuleInfo, PragmaExports),
     dead_proc_initialize_pragma_exports(PragmaExports, !Queue, !Needed),
+
+    module_info_user_init_pred_procs(!.ModuleInfo, InitProcs),
+    dead_proc_initialize_init_fn_procs(InitProcs, !Queue, !Needed),
+
+    module_info_user_final_pred_procs(!.ModuleInfo, FinalPreds),
+    dead_proc_initialize_init_fn_procs(FinalPreds, !Queue, !Needed),
+
     module_info_get_type_ctor_gen_infos(!.ModuleInfo, TypeCtorGenInfos),
     dead_proc_initialize_base_gen_infos(TypeCtorGenInfos, !Queue, !Needed),
+
     module_info_get_class_table(!.ModuleInfo, Classes),
     module_info_get_instance_table(!.ModuleInfo, Instances),
     dead_proc_initialize_class_methods(Classes, Instances, !Queue, !Needed).
@@ -196,6 +205,20 @@
     svmap.set(proc(PredId, ProcId), no, !Needed),
     dead_proc_initialize_pragma_exports(PragmaProcs, !Queue, !Needed).
 
+    % Add module initialisation/finalisation procedures to the queue and map
+    % as they cannot be removed.
+    %
+:- pred dead_proc_initialize_init_fn_procs(list(pred_proc_id)::in,
+    entity_queue::in, entity_queue::out, needed_map::in, needed_map::out)
+    is det.
+
+dead_proc_initialize_init_fn_procs([], !Queue, !Needed).
+dead_proc_initialize_init_fn_procs([PPId | PPIds], !Queue, !Needed) :-
+    PPId = proc(PredId, ProcId),
+    svqueue.put(proc(PredId, ProcId), !Queue),
+    svmap.set(proc(PredId, ProcId), no, !Needed),
+    dead_proc_initialize_init_fn_procs(PPIds, !Queue, !Needed).
+
 :- pred dead_proc_initialize_base_gen_infos(list(type_ctor_gen_info)::in,
     entity_queue::in, entity_queue::out, needed_map::in, needed_map::out)
     is det.
Index: compiler/elds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds.m,v
retrieving revision 1.10
diff -u -r1.10 elds.m
--- compiler/elds.m	1 Jun 2007 05:28:26 -0000	1.10
+++ compiler/elds.m	7 Jun 2007 02:41:38 -0000
@@ -54,7 +54,11 @@
                 elds_fe_funcs       :: list(elds_foreign_export_defn),
 
                 % Definitions of functions which return RTTI data.
-                elds_rtti_funcs     :: list(elds_rtti_defn)
+                elds_rtti_funcs     :: list(elds_rtti_defn),
+
+                % The init and final preds.
+                elds_init_preds     :: list(pred_proc_id),
+                elds_final_preds    :: list(pred_proc_id)
             ).
 
     % Function definition.
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.12
diff -u -r1.12 elds_to_erlang.m
--- compiler/elds_to_erlang.m	6 Jun 2007 01:26:26 -0000	1.12
+++ compiler/elds_to_erlang.m	7 Jun 2007 02:41:38 -0000
@@ -79,7 +79,7 @@
 
 output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
     ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns,
-        RttiDefns),
+        RttiDefns, InitPreds, FinalPreds),
     AddMainWrapper = should_add_main_wrapper(ModuleInfo),
 
     % Output intro.
@@ -104,21 +104,39 @@
     list.foldl2(output_foreign_export_ann, ForeignExportDefns,
         NeedComma0, NeedComma1, !IO),
     list.foldl2(output_rtti_export_ann(ModuleInfo), RttiDefns,
-        NeedComma1, NeedComma, !IO),
-    (
-        AddMainWrapper = yes,
-        maybe_write_comma(NeedComma, !IO),
-        nl_indent_line(1, !IO),
-        output_atom("mercury__main_wrapper", !IO),
-        io.write_string("/0", !IO)
-    ;
-        AddMainWrapper = no
-    ),
+        NeedComma1, _NeedComma, !IO),
+    output_wrapper_init_fn_export_ann(AddMainWrapper, InitPreds, FinalPreds,
+        !IO),
     io.write_string("]).\n", !IO),
 
     % Useful for debugging.
     io.write_string("% -compile(export_all).\n", !IO),
 
+    % Write directives for mkinit_erl.
+    ErlangModuleNameStr = erlang_module_name_to_str(ModuleName),
+    (
+        InitPreds = []
+    ;
+        InitPreds = [_ | _],
+        io.write_string("% REQUIRED_INIT ", !IO),
+        output_atom(ErlangModuleNameStr, !IO),
+        io.write_string(":mercury__required_init\n", !IO)
+    ),
+    (
+        FinalPreds = []
+    ;
+        FinalPreds = [_ | _],
+        io.write_string("% REQUIRED_FINAL ", !IO),
+        output_atom(ErlangModuleNameStr, !IO),
+        io.write_string(":mercury__required_final\n", !IO)
+    ),
+    % We always write out ENDINIT so that mkinit_erl doesn't scan the whole
+    % file.
+    io.write_string("% ENDINIT\n", !IO),
+
+    % Output foreign code written in Erlang.
+    list.foldl(output_foreign_body_code, ForeignBodies, !IO),
+
     % Output the main wrapper, if any.
     (
         AddMainWrapper = yes,
@@ -126,9 +144,10 @@
     ;
         AddMainWrapper = no
     ),
-
-    % Output foreign code written in Erlang.
-    list.foldl(output_foreign_body_code, ForeignBodies, !IO),
+    maybe_output_required_init_or_final(ModuleInfo, "mercury__required_init",
+        InitPreds, !IO),
+    maybe_output_required_init_or_final(ModuleInfo, "mercury__required_final",
+        FinalPreds, !IO),
 
     % Output function definitions.
     list.foldl(output_defn(ModuleInfo), ProcDefns, !IO),
@@ -192,6 +211,38 @@
         IsExported = no
     ).
 
+:- pred output_wrapper_init_fn_export_ann(bool::in, list(pred_proc_id)::in,
+    list(pred_proc_id)::in, io::di, io::uo) is det.
+
+output_wrapper_init_fn_export_ann(AddMainWrapper, InitPreds, FinalPreds, !IO) :-
+    (
+        AddMainWrapper = yes,
+        comma(!IO),
+        nl_indent_line(1, !IO),
+        output_atom("mercury__main_wrapper", !IO),
+        io.write_string("/0", !IO)
+    ;
+        AddMainWrapper = no
+    ),
+    (
+        InitPreds = []
+    ;
+        InitPreds = [_ | _],
+        comma(!IO),
+        nl_indent_line(1, !IO),
+        output_atom("mercury__required_init", !IO),
+        io.write_string("/0", !IO)
+    ),
+    (
+        FinalPreds = []
+    ;
+        FinalPreds = [_ | _],
+        comma(!IO),
+        nl_indent_line(1, !IO),
+        output_atom("mercury__required_final", !IO),
+        io.write_string("/0", !IO)
+    ).
+
 %-----------------------------------------------------------------------------%
 
 :- func should_add_main_wrapper(module_info) = bool.
@@ -220,14 +271,17 @@
 
     mercury__main_wrapper() ->
         mercury__io:'ML_io_init_state'(),
+        InitModule = list_to_atom(atom_to_list(?MODULE) ++ ""_init""),
         try
-            main_2_p_0()
+            InitModule:init_modules(),
+            InitModule:init_modules_required(),
+            main_2_p_0(),
+            InitModule:final_modules_required()
         catch
             {'ML_exception', Excp} ->
                 StackTrace = erlang:get_stacktrace(),
                 mercury__exception:'ML_report_uncaught_exception'(Excp),
-                io:put_chars(""Stack dump follows:\\n""),
-                mercury__dump_stacktrace(StackTrace),
+                mercury__maybe_dump_stacktrace(StackTrace),
                 mercury__io:'ML_io_finalize_state'(),
                 % init:stop is preferred to calling halt but there seems
                 % to be no way to choose the exit code otherwise.
@@ -235,6 +289,15 @@
         end,
         mercury__io:'ML_io_finalize_state'().
 
+    mercury__maybe_dump_stacktrace(StackTrace) ->
+        case os:getenv(""MERCURY_SUPPRESS_STACK_TRACE"") of
+            false ->
+                io:put_chars(""Stack dump follows:\\n""),
+                mercury__dump_stacktrace(StackTrace);
+            _ ->
+                void
+        end.
+
     mercury__dump_stacktrace([]) -> void;
     mercury__dump_stacktrace([St | Sts]) ->
         {Module, Function, ArityOrArgs} = St,
@@ -264,6 +327,32 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred maybe_output_required_init_or_final(module_info::in, string::in,
+    list(pred_proc_id)::in, io::di, io::uo) is det.
+
+maybe_output_required_init_or_final(ModuleInfo, Name, PredProcIds, !IO) :-
+    (
+        PredProcIds = []
+    ;
+        PredProcIds = [_ | _],
+        nl_indent_line(1, !IO),
+        io.write_string(Name, !IO),
+        io.write_string("() ->", !IO),
+        list.foldl(output_init_fn_call(ModuleInfo), PredProcIds, !IO),
+        nl_indent_line(1, !IO),
+        io.write_string("void.\n", !IO)
+    ).
+
+:- pred output_init_fn_call(module_info::in, pred_proc_id::in,
+    io::di, io::uo) is det.
+
+output_init_fn_call(ModuleInfo, PredProcId, !IO) :-
+    nl_indent_line(1, !IO),
+    output_pred_proc_id(ModuleInfo, PredProcId, !IO),
+    io.write_string("(),", !IO).
+
+%-----------------------------------------------------------------------------%
+
 output_defn(ModuleInfo, Defn, !IO) :-
     Defn = elds_defn(PredProcId, VarSet, Body),
     (
@@ -969,11 +1058,16 @@
 space(!IO) :-
     io.write_char(' ', !IO).
 
+:- pred comma(io::di, io::uo) is det.
+
+comma(!IO) :-
+    io.write_char(',', !IO).
+
 :- pred maybe_write_comma(bool::in, io::di, io::uo) is det.
 
 maybe_write_comma(no, !IO).
 maybe_write_comma(yes, !IO) :-
-    io.write_char(',', !IO).
+    comma(!IO).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.10
diff -u -r1.10 erl_code_gen.m
--- compiler/erl_code_gen.m	6 Jun 2007 22:23:53 -0000	1.10
+++ compiler/erl_code_gen.m	7 Jun 2007 02:41:38 -0000
@@ -85,8 +85,10 @@
     erl_gen_foreign_exports(ProcDefns, PragmaExports, ForeignExportDefns),
     % RTTI function definitions are added later by rtti_data_list_to_elds.
     RttiDefns = [],
+    module_info_user_init_pred_procs(ModuleInfo, InitPredProcs),
+    module_info_user_final_pred_procs(ModuleInfo, FinalPredProcs),
     ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns,
-        RttiDefns).
+        RttiDefns, InitPredProcs, FinalPredProcs).
 
 :- pred filter_erlang_foreigns(module_info::in, list(foreign_body_code)::out,
     list(pragma_exported_proc)::out, io::di, io::uo) is det.
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.150
diff -u -r1.150 hlds_module.m
--- compiler/hlds_module.m	4 Mar 2007 23:37:57 -0000	1.150
+++ compiler/hlds_module.m	7 Jun 2007 02:41:38 -0000
@@ -464,24 +464,24 @@
 :- pred module_info_set_complexity_proc_infos(list(complexity_proc_info)::in,
     module_info::in, module_info::out) is det.
 
-:- pred module_info_new_user_init_pred(sym_name::in, string::out,
+:- pred module_info_new_user_init_pred(sym_name::in, arity::in, string::out,
     module_info::in, module_info::out) is det.
 
-:- pred module_info_user_init_pred_c_name(module_info::in, sym_name::in,
-    string::out) is det.
-
 :- pred module_info_user_init_pred_c_names(module_info::in,
     list(string)::out) is det.
 
-:- pred module_info_new_user_final_pred(sym_name::in, string::out,
-    module_info::in, module_info::out) is det.
+:- pred module_info_user_init_pred_procs(module_info::in,
+    list(pred_proc_id)::out) is det.
 
-:- pred module_info_user_final_pred_c_name(module_info::in, sym_name::in,
-    string::out) is det.
+:- pred module_info_new_user_final_pred(sym_name::in, arity::in, string::out,
+    module_info::in, module_info::out) is det.
 
 :- pred module_info_user_final_pred_c_names(module_info::in,
     list(string)::out) is det.
 
+:- pred module_info_user_final_pred_procs(module_info::in,
+    list(pred_proc_id)::out) is det.
+
 :- pred module_info_get_structure_reuse_map(module_info::in,
     structure_reuse_map::out) is det.
 
@@ -749,12 +749,14 @@
 
                 % Exported C names for preds appearing in `:- initialise
                 % initpred' directives in this module, in order of appearance.
-                user_init_pred_c_names      :: assoc_list(sym_name, string),
+                user_init_pred_c_names      :: assoc_list(sym_name_and_arity,
+                                                string),
 
-                % Export C names fored pred appearing in `:- finalise
+                % Export C names for preds appearing in `:- finalise
                 % finalpred' directives in this module, in order of
                 % appearance.
-                user_final_pred_c_names     :: assoc_list(sym_name, string),
+                user_final_pred_c_names     :: assoc_list(sym_name_and_arity,
+                                                string),
 
                 % Information about which procedures implement structure reuse.
                 structure_reuse_map         :: structure_reuse_map,
@@ -911,56 +913,61 @@
     % we may wish to revisit this code. The reference manual is therefore
     % deliberately quiet on the subject.
     %
-module_info_new_user_init_pred(SymName, CName, MI0, MI) :-
+module_info_new_user_init_pred(SymName, Arity, CName, MI0, MI) :-
     InitPredCNames0 = MI0 ^ sub_info ^ user_init_pred_c_names,
     UserInitPredNo = list.length(InitPredCNames0),
     module_info_get_name(MI0, ModuleSymName),
     ModuleName = prog_foreign.sym_name_mangle(ModuleSymName),
     CName = string.format("%s__user_init_pred_%d",
         [s(ModuleName), i(UserInitPredNo)]),
-    InitPredCNames = InitPredCNames0 ++ [SymName - CName],
+    InitPredCNames = InitPredCNames0 ++ [SymName / Arity - CName],
     MI = MI0 ^ sub_info ^ user_init_pred_c_names := InitPredCNames.
 
-module_info_user_init_pred_c_name(MI, SymName, CName) :-
-    InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
-    ( assoc_list.search(InitPredCNames, SymName, CName0) ->
-        CName = CName0
-    ;
-        module_info_get_name(MI, ModuleSymName),
-        ModuleName = sym_name_to_string(ModuleSymName),
-        unexpected(ModuleName,
-            "lookup failure in module_info_user_init_pred_c_name")
-    ).
-
 module_info_user_init_pred_c_names(MI, CNames) :-
     InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
     CNames = assoc_list.values(InitPredCNames).
 
-module_info_new_user_final_pred(SymName, CName, MI0, MI) :-
+module_info_new_user_final_pred(SymName, Arity, CName, MI0, MI) :-
     FinalPredCNames0 = MI0 ^ sub_info ^ user_final_pred_c_names,
     UserFinalPredNo = list.length(FinalPredCNames0),
     module_info_get_name(MI0, ModuleSymName),
     ModuleName = prog_foreign.sym_name_mangle(ModuleSymName),
     CName = string.format("%s__user_final_pred_%d",
         [s(ModuleName), i(UserFinalPredNo)]),
-    FinalPredCNames = FinalPredCNames0 ++ [SymName - CName],
+    FinalPredCNames = FinalPredCNames0 ++ [SymName / Arity - CName],
     MI = MI0 ^ sub_info ^ user_final_pred_c_names := FinalPredCNames.
 
-module_info_user_final_pred_c_name(MI, SymName, CName) :-
-    FinalPredCNames = MI ^ sub_info ^ user_final_pred_c_names,
-    ( assoc_list.search(FinalPredCNames, SymName, CName0) ->
-        CName = CName0
-    ;
-        module_info_get_name(MI, ModuleSymName),
-        ModuleName = sym_name_to_string(ModuleSymName),
-        unexpected(ModuleName,
-            "lookup failure in module_info_user_final_pred_c_name")
-    ).
-
 module_info_user_final_pred_c_names(MI, CNames) :-
     FinalPredCNames = MI ^ sub_info ^ user_final_pred_c_names,
     CNames = assoc_list.values(FinalPredCNames).
 
+module_info_user_init_pred_procs(MI, PredProcIds) :-
+    InitPredSymNames = MI ^ sub_info ^ user_init_pred_c_names,
+    SymNameAndArities = assoc_list.keys(InitPredSymNames),
+    list.map(module_info_user_init_fn_pred_procs_2(MI), SymNameAndArities,
+        PredProcIds).
+
+module_info_user_final_pred_procs(MI, PredProcIds) :-
+    FinalPredSymNames = MI ^ sub_info ^ user_final_pred_c_names,
+    SymNameAndArities = assoc_list.keys(FinalPredSymNames),
+    list.map(module_info_user_init_fn_pred_procs_2(MI), SymNameAndArities,
+        PredProcIds).
+
+:- pred module_info_user_init_fn_pred_procs_2(module_info::in,
+    sym_name_and_arity::in, pred_proc_id::out) is det.
+
+module_info_user_init_fn_pred_procs_2(MI, SymName / Arity, PredProcId) :-
+    module_info_get_predicate_table(MI, PredTable),
+    (
+        predicate_table_search_pred_sym_arity(PredTable,
+            may_be_partially_qualified, SymName, Arity, [PredId])
+    ->
+        pred_table.get_proc_id(MI, PredId, ProcId),
+        PredProcId = proc(PredId, ProcId)
+    ;
+        unexpected(this_file, "module_info_user_init_fn_pred_procs_2")
+    ).
+
 %-----------------------------------------------------------------------------%
 
     % Various predicates which modify the module_sub_info data structure
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.73
diff -u -r1.73 make.program_target.m
--- compiler/make.program_target.m	30 May 2007 05:15:05 -0000	1.73
+++ compiler/make.program_target.m	7 Jun 2007 02:41:38 -0000
@@ -363,23 +363,45 @@
     % libraries linked using dlopen().
     AllModulesList = set.to_sorted_list(AllModules),
     (
-        FileType = executable,
-        ( CompilationTarget = target_c
-        ; CompilationTarget = target_asm
-        )
+        FileType = executable
     ->
-        compile_target_code.make_init_obj_file(ErrorStream,
-            MainModuleName, AllModulesList, InitObjectResult, !IO),
         (
-            InitObjectResult = yes(InitObject),
-            % We may need to update the timestamp of the `_init.o' file.
-            !:Info = !.Info ^ file_timestamps :=
-                map.delete(!.Info ^ file_timestamps, InitObject),
-            InitObjects = [InitObject],
-            DepsResult2 = BuildDepsResult
+            ( CompilationTarget = target_c
+            ; CompilationTarget = target_asm
+            ),
+            make_init_obj_file(ErrorStream, MainModuleName,
+                AllModulesList, InitObjectResult, !IO),
+            MaybeInitObjectResult = yes(InitObjectResult)
         ;
-            InitObjectResult = no,
-            DepsResult2 = deps_error,
+            CompilationTarget = target_erlang,
+            make_erlang_program_init_file(ErrorStream, MainModuleName,
+                AllModulesList, InitObjectResult, !IO),
+            MaybeInitObjectResult = yes(InitObjectResult)
+        ;
+            ( CompilationTarget = target_il
+            ; CompilationTarget = target_java
+            ; CompilationTarget = target_x86_64
+            ),
+            MaybeInitObjectResult = no
+        ),
+        (
+            MaybeInitObjectResult = yes(InitObjectResult1),
+            (
+                InitObjectResult1 = yes(InitObject),
+                % We may need to update the timestamp of the `_init.o'
+                % or `_init.beam' file.
+                !:Info = !.Info ^ file_timestamps :=
+                    map.delete(!.Info ^ file_timestamps, InitObject),
+                InitObjects = [InitObject],
+                DepsResult2 = BuildDepsResult
+            ;
+                InitObjectResult1 = no,
+                DepsResult2 = deps_error,
+                InitObjects = []
+            )
+        ;
+            MaybeInitObjectResult = no,
+            DepsResult2 = BuildDepsResult,
             InitObjects = []
         )
     ;
@@ -871,7 +893,7 @@
         sorry(this_file, "build_library: target x86_64 not supported yet")
     ;
         Target = target_erlang,
-        build_erlang_library(MainModuleName, Succeeded, !Info, !IO)
+        build_erlang_library(MainModuleName, AllModules, Succeeded, !Info, !IO)
     ).
 
 :- pred build_c_library(module_name::in, list(module_name)::in, bool::out,
@@ -899,7 +921,7 @@
             SharedLibsSucceeded = yes,
             % Errors while making the .init file should be very rare.
             io.output_stream(ErrorStream, !IO),
-            make_init_file(ErrorStream, MainModuleName,
+            make_library_init_file(ErrorStream, MainModuleName,
                 AllModules, Succeeded, !IO)
         ;
             SharedLibsSucceeded = no,
@@ -918,13 +940,23 @@
         linked_target_file(MainModuleName, java_archive),
         Succeeded, !Info, !IO).
 
-:- pred build_erlang_library(module_name::in, bool::out,
-    make_info::in, make_info::out, io::di, io::uo) is det.
+:- pred build_erlang_library(module_name::in, list(module_name)::in,
+    bool::out, make_info::in, make_info::out, io::di, io::uo) is det.
 
-build_erlang_library(MainModuleName, Succeeded, !Info, !IO) :-
+build_erlang_library(MainModuleName, AllModules, Succeeded, !Info, !IO) :-
     make_linked_target(
         linked_target_file(MainModuleName, erlang_archive),
-        Succeeded, !Info, !IO).
+        Succeeded0, !Info, !IO),
+    (
+        Succeeded0 = yes,
+        % Errors while making the .init file should be very rare.
+        io.output_stream(ErrorStream, !IO),
+        make_erlang_library_init_file(ErrorStream, MainModuleName,
+            AllModules, Succeeded, !IO)
+    ;
+        Succeeded0 = no,
+        Succeeded = no
+    ).
 
 %-----------------------------------------------------------------------------%
 
@@ -1157,7 +1189,7 @@
             % Our "Erlang archives" are actually directories.
             install_directory(ErlangArchiveFileName, GradeLibDir,
                 LibsSucceeded, !IO),
-            InitSucceeded = yes
+            install_grade_init(GradeDir, ModuleName, InitSucceeded, !IO)
         ;
             GradeLibDir = Prefix/"lib"/"mercury"/"lib"/GradeDir,
             maybe_install_library_file("static", LibFileName, GradeLibDir,
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.67
diff -u -r1.67 make_hlds_passes.m
--- compiler/make_hlds_passes.m	7 May 2007 05:21:31 -0000	1.67
+++ compiler/make_hlds_passes.m	7 Jun 2007 02:41:38 -0000
@@ -1080,11 +1080,15 @@
         !QualInfo, !Specs).
 add_item_clause(item_initialise(user, SymName, Arity), !Status, Context,
         !ModuleInfo, !QualInfo, !Specs) :-
-    % To handle a `:- initialise initpred.' declaration we need to:
+    % To handle a `:- initialise initpred.' declaration for C backends we need
+    % to:
     % (1) construct a new C function name, CName, to use to export initpred,
     % (2) add the export pragma that does this
     % (3) record the initpred/cname pair in the ModuleInfo so that
     % code generation can ensure cname is called during module initialisation.
+    %
+    % For the Erlang backend, we need to have the initpred recorded in the
+    % ModuleInfo. This is implied by the handling for the C backends.
 
     module_info_get_predicate_table(!.ModuleInfo, PredTable),
     (
@@ -1111,7 +1115,8 @@
                 pred_info_get_purity(PredInfo, Purity),
                 Purity = purity_pure
             ->
-                module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
+                module_info_new_user_init_pred(SymName, Arity, CName,
+                    !ModuleInfo),
                 PragmaExportItem =
                     item_pragma(compiler(initialise_decl),
                         pragma_foreign_export(ExportLang, SymName,
@@ -1130,7 +1135,8 @@
                 pred_info_get_purity(PredInfo, Purity),
                 Purity = purity_impure
             ->
-                module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
+                module_info_new_user_init_pred(SymName, Arity, CName,
+                    !ModuleInfo),
                 PragmaExportedItem =
                     item_pragma(compiler(initialise_decl),
                         pragma_foreign_export(ExportLang, SymName,
@@ -1163,7 +1169,7 @@
         Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
         !:Specs = [Spec | !.Specs]
     ).
-add_item_clause(item_initialise(compiler(Details), SymName, _Arity),
+add_item_clause(item_initialise(compiler(Details), SymName, Arity),
         !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
     % The compiler introduces initialise declarations that call impure
     % predicates as part of the source-to-source transformation for mutable
@@ -1172,7 +1178,7 @@
 
     (
         Details = mutable_decl,
-        module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
+        module_info_new_user_init_pred(SymName, Arity, CName, !ModuleInfo),
         ExportLang = lang_c,    % XXX Implement for other backends.
         PragmaExportItem =
             item_pragma(compiler(mutable_decl),
@@ -1191,11 +1197,15 @@
     ).
 add_item_clause(item_finalise(Origin, SymName, Arity),
         !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
-    % To handle a `:- finalise finalpred.' declaration we need to:
+    % To handle a `:- finalise finalpred.' declaration for C backends we need
+    % to:
     % (1) construct a new C function name, CName, to use to export finalpred,
     % (2) add `:- pragma foreign_export("C", finalpred(di, uo), CName).',
     % (3) record the finalpred/cname pair in the ModuleInfo so that
     % code generation can ensure cname is called during module finalisation.
+    %
+    % For the Erlang backend, we need to have the finalpred recorded in the
+    % ModuleInfo. This is implied by the handling for the C backends.
     
     ( 
         Origin = compiler(_),
@@ -1231,7 +1241,8 @@
                 pred_info_get_purity(PredInfo, Purity),
                 Purity = purity_pure
             ->
-                module_info_new_user_final_pred(SymName, CName, !ModuleInfo),
+                module_info_new_user_final_pred(SymName, Arity, CName,
+                    !ModuleInfo),
                 PragmaExportItem =
                     item_pragma(compiler(finalise_decl),
                         pragma_foreign_export(ExportLang, SymName,
@@ -1250,7 +1261,8 @@
                 pred_info_get_purity(PredInfo, Purity),
                 Purity = purity_impure
             ->
-                module_info_new_user_final_pred(SymName, CName, !ModuleInfo),
+                module_info_new_user_final_pred(SymName, Arity, CName,
+                    !ModuleInfo),
                 PragmaExportItem =
                     item_pragma(compiler(finalise_decl),
                         pragma_foreign_export(ExportLang, SymName,
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.439
diff -u -r1.439 mercury_compile.m
--- compiler/mercury_compile.m	1 Jun 2007 02:41:20 -0000	1.439
+++ compiler/mercury_compile.m	7 Jun 2007 02:41:38 -0000
@@ -5224,10 +5224,11 @@
     RttiDatas = TypeCtorRttiData ++ TypeClassInfoRttiData,
     ErlangRttiDatas = list.map(erlang_rtti_data(HLDS), RttiDatas),
 
-    ELDS0 = elds(ModuleName, ForeignBodies, Defns, FEDefns, RttiDefns0),
+    ELDS0 = elds(ModuleName, ForeignBodies, Defns, FEDefns, RttiDefns0,
+        InitPreds, FinalPreds),
     rtti_data_list_to_elds(HLDS, ErlangRttiDatas, RttiDefns),
     ELDS = elds(ModuleName, ForeignBodies, Defns, FEDefns,
-        RttiDefns0 ++ RttiDefns).
+        RttiDefns0 ++ RttiDefns, InitPreds, FinalPreds).
 
 :- pred elds_to_erlang(module_info::in, elds::in, io::di, io::uo) is det.
 
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.429
diff -u -r1.429 modules.m
--- compiler/modules.m	6 Jun 2007 01:26:27 -0000	1.429
+++ compiler/modules.m	7 Jun 2007 02:41:39 -0000
@@ -874,8 +874,8 @@
         source_file_map.lookup_module_source_file(ModuleName0, FileName, !IO)
     ;
         (
-            ( Ext = ".erl" 
-            ; Ext = ".beam"
+            ( string.suffix(Ext, ".erl")
+            ; string.suffix(Ext, ".beam")
             )
         ->
             % Erlang uses `.' as a package separator and expects a module
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.563
diff -u -r1.563 options.m
--- compiler/options.m	30 May 2007 05:15:05 -0000	1.563
+++ compiler/options.m	7 Jun 2007 02:41:39 -0000
@@ -744,6 +744,7 @@
     ;       ranlib_command
     ;       ranlib_flags
     ;       mkinit_command
+    ;       mkinit_erl_command
     ;       demangle_command
     ;       trace_libs
     ;       thread_libs
@@ -1509,6 +1510,7 @@
     ranlib_command                      -   string(""),
     ranlib_flags                        -   string(""),
     mkinit_command                      -   string("mkinit"),
+    mkinit_erl_command                  -   string("mkinit_erl"),
     demangle_command                    -   string("mdemangle"),
     trace_libs                          -   string(""),
     thread_libs                         -   string(""),
@@ -2310,6 +2312,7 @@
 long_option("ranlib-command",       ranlib_command).
 long_option("ranlib-flags",         ranlib_flags).
 long_option("mkinit-command",       mkinit_command).
+long_option("mkinit-erl-command",   mkinit_erl_command).
 long_option("demangle-command",     demangle_command).
 long_option("trace-libs",           trace_libs).
 long_option("thread-libs",          thread_libs).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.319
diff -u -r1.319 Mmakefile
--- tests/hard_coded/Mmakefile	6 Jun 2007 01:48:10 -0000	1.319
+++ tests/hard_coded/Mmakefile	7 Jun 2007 02:41:39 -0000
@@ -627,7 +627,7 @@
 # final_excp.out is expected to fail (it calls throw/1).
 #
 final_excp.out: final_excp
-	if MERCURY_SUPPRESS_STACK_STRACE=yes ./final_excp > $@.tmp 2>&1; then \
+	if MERCURY_SUPPRESS_STACK_TRACE=yes ./final_excp > $@.tmp 2>&1; then \
 		grep  . $@.tmp; \
 		exit 1; \
 	else \
@@ -647,7 +647,7 @@
 # mutable_excp.out is expected to fail (it calls throw/1).
 #
 mutable_excp.out: mutable_excp
-	if MERCURY_SUPRRESS_STACK_TRACE=yes ./mutable_excp > $@.tmp 2>&1; then \
+	if MERCURY_SUPPRESS_STACK_TRACE=yes ./mutable_excp > $@.tmp 2>&1; then \
 		grep  . $@.tmp; \
 		exit 1; \
 	else \
Index: tests/hard_coded/impure_init_and_final.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/impure_init_and_final.m,v
retrieving revision 1.1
diff -u -r1.1 impure_init_and_final.m
--- tests/hard_coded/impure_init_and_final.m	4 Oct 2005 07:20:22 -0000	1.1
+++ tests/hard_coded/impure_init_and_final.m	7 Jun 2007 02:41:39 -0000
@@ -22,6 +22,13 @@
 "
 	puts(S);
 ").
+:- pragma foreign_proc("Erlang",
+	puts(S::in),
+	[will_not_call_mercury],
+"
+	io:put_chars(S),
+	io:nl()
+").
 
 :- impure pred init is det.
 
Index: util/.cvsignore
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/.cvsignore,v
retrieving revision 1.3
diff -u -r1.3 .cvsignore
--- util/.cvsignore	7 May 2007 06:59:24 -0000	1.3
+++ util/.cvsignore	7 Jun 2007 02:41:39 -0000
@@ -1,4 +1,5 @@
 mkinit
+mkinit_erl
 mdemangle
 info_to_mdb
 pad_backslash
Index: util/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/Mmakefile,v
retrieving revision 1.19
diff -u -r1.19 Mmakefile
--- util/Mmakefile	29 Nov 2006 04:51:41 -0000	1.19
+++ util/Mmakefile	7 Jun 2007 02:41:39 -0000
@@ -19,7 +19,7 @@
 # we need -I ../runtime for "mercury_std.h", etc.
 # the -O0 is to get around a stupid compiler bug in gcc 2.7.2.3 on cyclone
 
-PROGS=mkinit mdemangle info_to_mdb
+PROGS=mkinit mkinit_erl mdemangle info_to_mdb
 PROGFILENAMES=$(PROGS:%=%$(EXT_FOR_EXE))
 SRC=$(PROGS:%=%.c)
 
@@ -33,6 +33,7 @@
 
 # mkinit.c needs `struct stat'
 MGNUCFLAGS-mkinit = --no-ansi
+MGNUCFLAGS-mkinit_erl = --no-ansi
 
 #-----------------------------------------------------------------------------#
 
Index: util/mkinit.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit.c,v
retrieving revision 1.115
diff -u -r1.115 mkinit.c
--- util/mkinit.c	9 Feb 2007 04:05:18 -0000	1.115
+++ util/mkinit.c	7 Jun 2007 02:41:39 -0000
@@ -31,6 +31,7 @@
 **      - compiler/compile_target_code.m
 **          in particular the predicates make_init_obj/7 and 
 **          make_standalone_interface/3.
+**      - util/mkinit_erl.c
 **
 */
 
@@ -784,7 +785,11 @@
     int         i;
     String_List *tmp_slist;
 
-    while ((c = getopt(argc, argv, "A:c:g:iI:lo:r:tw:xX:ks")) != EOF) {
+    /*
+    ** The set of options for mkinit and mkinit_erl should be
+    ** kept in sync, even if they may not necessarily make sense.
+    */
+    while ((c = getopt(argc, argv, "A:c:g:iI:lm:o:r:tw:xX:ks")) != EOF) {
         switch (c) {
         case 'A':
             /*
@@ -834,6 +839,10 @@
             output_main_func = MR_FALSE;
             break;
 
+        case 'm':
+            /* Ignored: used by mkinit_erl. */
+            break;
+
         case 'o':
             if (strcmp(optarg, "-") == 0) {
                 output_file_name = NULL; /* output to stdout */
@@ -912,6 +921,7 @@
     fputs("  -I dir:\tadd dir to the search path for init files\n", stderr);
     fputs("  -k:\t\tgenerate the .init for a library\n", stderr);
     fputs("  -s:\t\tgenerate a standalone runtime interface\n", stderr);
+    fputs("  -m:\t\t(ignored)\n", stderr);
     exit(EXIT_FAILURE);
 }
 
Index: util/mkinit_erl.c
===================================================================
RCS file: util/mkinit_erl.c
diff -N util/mkinit_erl.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ util/mkinit_erl.c	7 Jun 2007 02:41:39 -0000
@@ -0,0 +1,955 @@
+/*
+** vim:sw=4 ts=4 expandtab
+*/
+/*
+** Copyright (C) 1995-2007 The University of Melbourne.
+** This file may only be copied under the terms of the GNU General
+** Public License - see the file COPYING in the Mercury distribution.
+*/
+
+/*
+** File: mkinit_erl.c
+** Main authors: zs, fjh, wangp
+**
+** Given a list of .erl or .init files on the command line, this program
+** produces the initialization file (usually called *_init.erl) on stdout.
+** The initialization file is a small program that calls the initialization
+** functions for all the modules in a Mercury program.
+**
+** Alternatively, if invoked with the -k option, this program produces a
+** list of intialization directives on stdout.  This mode of operation is
+** is used when building .init files for libraries.
+**
+** If invoked with the -s option, this program produces a standalone 
+** runtime interface on stdout.  This mode of operation is used when
+** using Mercury libraries from applications written in foreign languages.
+**
+** NOTE: any changes to this program may need to be reflected in the
+** following places:
+**
+**      - scripts/c2init.in
+**      - compiler/compile_target_code.m
+**          in particular the predicates make_init_obj/7 and 
+**          make_standalone_interface/3.
+**      - util/mkinit.c
+**
+*/
+
+/*---------------------------------------------------------------------------*/
+
+/* mercury_std.h includes mercury_regs.h, and must precede system headers */
+#include    "mercury_conf.h"
+#include    "mercury_std.h"
+#include    "getopt.h"
+#include    "mercury_array_macros.h"
+
+/*
+** mercury_array_macros.h uses the MR_NEW_ARRAY and MR_RESIZE_ARRAY macros.
+*/
+
+#define MR_NEW_ARRAY(type, num) \
+        ((type *) malloc((num) * sizeof(type)))
+
+#define MR_RESIZE_ARRAY(ptr, type, num) \
+        ((type *) realloc((ptr), (num) * sizeof(type)))
+
+
+#include    <stdio.h>
+#include    <stdlib.h>
+#include    <string.h>
+#include    <ctype.h>
+#include    <errno.h>
+
+#ifdef MR_HAVE_SYS_STAT_H
+  #include  <sys/stat.h>
+#endif
+
+#ifdef MR_HAVE_UNISTD_H
+  #include  <unistd.h>
+#endif
+
+/* --- adjustable limits --- */
+#define MAXLINE     256 /* maximum number of characters per line */
+                        /* (characters after this limit are ignored) */
+
+/* --- used to collect a list of strings --- */
+
+typedef struct String_List_struct {
+    char                        *data;
+    struct String_List_struct   *next;
+} String_List;
+
+typedef enum
+{
+    TASK_OUTPUT_INIT_PROG = 0,
+    TASK_OUTPUT_LIB_INIT  = 1
+} Task;
+
+/* 
+** Most of these won't apply to the Erlang backend, but let's not introduce
+** unnecessary differences with mkinit.
+*/
+typedef enum
+{
+    PURPOSE_INIT = 0,
+    PURPOSE_TYPE_TABLE = 1,
+    PURPOSE_DEBUGGER = 2,
+    PURPOSE_COMPLEXITY = 3,
+    PURPOSE_PROC_STATIC = 4,
+    PURPOSE_REQ_INIT = 5,
+    PURPOSE_REQ_FINAL = 6
+} Purpose;
+
+const char  *main_func_name[] =
+{
+    "init_modules",
+    "init_modules_type_tables",
+    "init_modules_debugger",
+    "init_modules_complexity_procs",
+    "write_out_proc_statics",
+    "init_modules_required",
+    "final_modules_required"
+};
+
+const char  *module_suffix[] =
+{
+    "init",
+    "init_type_tables",
+    "init_debugger",
+    "init_complexity_procs",
+    "write_out_proc_statics",
+    "",
+    "",
+};
+
+const char  *init_suffix[] =
+{
+    "",
+    "_type_tables",
+    "_debugger",
+    "_complexity",
+    "write_out_proc_statics"
+};
+
+/* --- global variables --- */
+
+static const char *MR_progname = NULL;
+
+/*
+** List of names of the modules to call all the usual initialization
+** functions for: "init", "init_type_tables", "init_debugger" and (with
+** the right #defines) "init_complexity_procs" and "write_out_proc_statics".
+*/
+
+static const char   **std_modules = NULL;
+static int          std_module_max = 0;
+static int          std_module_next = 0;
+#define MR_INIT_STD_MODULE_SIZE     100
+
+/*
+** List of names of handwritten modules, for which we call a limited set
+** of initialization functions: "init", "init_type_tables" and (with
+** the right #defines) "write_out_proc_statics". We don't call
+** "init_debugger" functions since handwritten modules don't have module
+** layouts, and we don't generate "init_complexity_procs" since they have
+** no Mercury code to measure the complexity of.
+*/
+
+static const char   **special_modules = NULL;
+static int          special_module_max = 0;
+static int          special_module_next = 0;
+#define MR_INIT_SPECIAL_MODULE_SIZE     10
+
+/*
+** The concatenation of std_modules and special_modules; created with the
+** right size (std_module_next + special_module_next).
+*/
+static const char   **std_and_special_modules = NULL;
+
+/*
+** List of names of modules that have initialization functions that should
+** always be run. This is currently used to initialize the states of constraint
+** solvers. We call an "init_required" function for each such module.
+*/
+static const char   **req_init_modules = NULL;
+static int          req_init_module_max = 0;
+static int          req_init_module_next = 0;
+#define MR_INIT_REQ_MODULE_SIZE     10
+
+/*
+** List of names of modules that have finalisation functions that should
+** always be run.  We call a "final_required" function for each such module.
+*/
+static const char   **req_final_modules = NULL;
+static int          req_final_module_max = 0;
+static int          req_final_module_next = 0;
+#define MR_FINAL_REQ_MODULE_SIZE    10
+
+/*
+** List of names of environment variables whose values should be sampled
+** at initialization.
+** NOTE: the Erlang backend does not yet use these.
+*/
+static const char   **mercury_env_vars = NULL;
+static int          mercury_env_var_max = 0;
+static int          mercury_env_var_next = 0;
+#define MR_ENV_VAR_LIST_SIZE    10
+
+/* options and arguments, set by parse_options() */
+static const char   *output_file_name = NULL;
+static const char   *grade = "";
+static const char   *module_name = "unknown_module_name";
+static int          num_files;
+static char         **files;
+static Task         output_task = TASK_OUTPUT_INIT_PROG;
+
+static int          num_errors = 0;
+
+    /* List of directories to search for init files */
+static String_List  *init_file_dirs = NULL;
+
+    /* Pointer to tail of the init_file_dirs list */
+static String_List  **init_file_dirs_tail = &init_file_dirs;
+
+/* --- code fragments to put in the output file --- */
+static const char header1[] =
+    "%%\n"
+    "%% This code was automatically generated by mkinit_erl - do not edit.\n"
+    "%%\n"
+    "%% Grade: %s\n"
+    "%% Input files:\n"
+    "%%\n"
+    ;
+
+/* --- function prototypes --- */
+static  void    parse_options(int argc, char *argv[]);
+static  void    usage(void);
+static  void    set_output_file(void);
+static  void    do_path_search(void);
+static  char    *find_init_file(const char *base_name);
+static  MR_bool file_exists(const char *filename);
+static  char    *read_line(const char *filename, FILE *fp, int max);
+static  void    output_headers(void);
+static  void    output_init_function(Purpose purpose,
+                    const char **func_names, int num_func_names);
+static  void    output_main(void);
+static  int     output_lib_init_file(void);
+static  int     output_init_program(void);
+static  void    process_file(const char *filename);
+static  void    process_init_file(const char *filename, const char *prefix);
+static  int     get_line(FILE *file, char *line, int line_max);
+static  void    *checked_malloc(size_t size);
+static  char    *checked_strdup(const char *str);
+static  char    *checked_strdupcat(const char *str, const char *suffix);
+
+/*---------------------------------------------------------------------------*/
+
+#ifndef MR_HAVE_STRERROR
+
+/*
+** Apparently SunOS 4.1.3 doesn't have strerror()
+** (!%^&!^% non-ANSI systems, grumble...)
+**
+** This code is duplicated in runtime/mercury_prof.c.
+*/
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+char *
+strerror(int errnum)
+{
+    if (errnum >= 0 && errnum < sys_nerr && sys_errlist[errnum] != NULL) {
+        return sys_errlist[errnum];
+    } else {
+        static char buf[30];
+
+        sprintf(buf, "Error %d", errnum);
+        return buf;
+    }
+}
+
+#endif
+
+/*---------------------------------------------------------------------------*/
+
+#ifdef  CHECK_GET_LINE
+FILE    *check_fp;
+#endif
+
+int
+main(int argc, char **argv)
+{
+    int exit_status;
+
+    MR_progname = argv[0];
+
+    parse_options(argc, argv);
+
+#ifdef  CHECK_GET_LINE
+    check_fp = fopen(".check_get_line", "w");
+    /* If the open fails, we won't write to the file */
+#endif
+
+    set_output_file();
+
+    switch (output_task) {
+        case TASK_OUTPUT_LIB_INIT:
+            /* Output a .init file */
+            exit_status = output_lib_init_file();
+            break;
+        
+        case TASK_OUTPUT_INIT_PROG:
+            /* Output a _init.erl file. */
+            exit_status = output_init_program();
+            break;
+        
+        default:
+            fprintf(stderr, "%s: unknown task\n", MR_progname);
+            exit(EXIT_FAILURE);
+    }
+    
+    return exit_status;
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Output the initialisation file for a Mercury library, the .init file.
+*/
+static int
+output_lib_init_file(void)
+{
+    int filenum;
+    int i;
+
+    for (filenum = 0; filenum < num_files; filenum++) {
+            process_file(files[filenum]);
+    }
+
+    for (i = 0; i < std_module_next; i++) {
+        printf("INIT %s%s\n", std_modules[i], module_suffix[PURPOSE_INIT]);
+    }
+
+    for (i = 0; i < req_init_module_next; i++) {
+        printf("REQUIRED_INIT %s\n", req_init_modules[i]);
+    }
+
+    for (i = 0; i < req_final_module_next; i++) {
+        printf("REQUIRED_FINAL %s\n", req_final_modules[i]);
+    }
+
+    for (i = 0; i < mercury_env_var_next; i++) {
+        printf("ENVVAR %s\n", mercury_env_vars[i]);
+    }
+
+    if (num_errors > 0) {
+        fprintf(stderr, "%s: error while creating .init file.\n", MR_progname);
+        return EXIT_FAILURE;
+    } else {
+        return EXIT_SUCCESS;
+    }
+
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Output the initialisation program for a Mercury executable, the *_init.c
+** file.
+*/
+static int
+output_init_program(void)
+{
+    int filenum;
+    int num_bunches;
+    int i;
+
+    do_path_search();
+    output_headers();
+
+    for (filenum = 0; filenum < num_files; filenum++) {
+        process_file(files[filenum]);
+    }
+
+    std_and_special_modules = MR_NEW_ARRAY(const char *,
+        std_module_next + special_module_next);
+
+    for (i = 0; i < std_module_next; i++) {
+        std_and_special_modules[i] = std_modules[i];
+    }
+
+    for (i = 0; i < special_module_next; i++) {
+        std_and_special_modules[std_module_next + i] = special_modules[i];
+    }
+
+    fputs("\n", stdout);
+    fputs("-module('", stdout);
+    /* Make some effort at printing weird module names. */
+    for (i = 0; module_name[i] != '\0'; i++) {
+        switch (module_name[i]) {
+            case '\'':
+            case '\\':
+                fputc('\\', stdout);
+        }
+        fputc(module_name[i], stdout);
+    }
+    fputs("').\n", stdout);
+    fputs("-compile(export_all).\n\n", stdout);
+
+    output_init_function(PURPOSE_INIT,
+        std_and_special_modules, std_module_next + special_module_next);
+
+    output_init_function(PURPOSE_REQ_INIT,
+        req_init_modules, req_init_module_next);
+
+    output_init_function(PURPOSE_REQ_FINAL,
+        req_final_modules, req_final_module_next);
+
+    if (num_errors > 0) {
+        fputs("% Force syntax error, since there were\n", stdout);
+        fputs("% errors in the generation of this file\n", stdout);
+        fputs("#error \"You need to remake this file\"\n", stdout);
+        if (output_file_name != NULL) {
+            (void) fclose(stdout);
+            (void) remove(output_file_name);
+        }
+        return EXIT_FAILURE;
+    }
+
+    return EXIT_SUCCESS;
+}
+
+/*---------------------------------------------------------------------------*/
+
+static void
+parse_options(int argc, char *argv[])
+{
+    int         c;
+    int         i;
+    String_List *tmp_slist;
+
+    /*
+    ** The set of options for mkinit and mkinit_erl should be
+    ** kept in sync, even if they may not necessarily make sense.
+    */
+    while ((c = getopt(argc, argv, "A:c:g:iI:lo:r:tw:xX:ksm:")) != EOF) {
+        switch (c) {
+        case 'g':
+            grade = optarg;
+            break;
+
+        case 'I':
+            /*
+            ** Add the directory name to the end of the
+            ** search path for `.init' files.
+            */
+            tmp_slist = (String_List *) checked_malloc(sizeof(String_List));
+            tmp_slist->next = NULL;
+            tmp_slist->data = (char *) checked_malloc(strlen(optarg) + 1);
+            strcpy(tmp_slist->data, optarg);
+            *init_file_dirs_tail = tmp_slist;
+            init_file_dirs_tail = &tmp_slist->next;
+            break;
+
+        case 'm':
+            module_name = optarg;
+            break;
+
+        case 'o':
+            if (strcmp(optarg, "-") == 0) {
+                output_file_name = NULL; /* output to stdout */
+            } else {
+                output_file_name = optarg;
+            }
+            break;
+
+        case 'x':
+            /* We always assume this option. */
+            break;
+
+        case 'k':
+            output_task = TASK_OUTPUT_LIB_INIT;
+            break;
+
+        case 'A':
+        case 'c':
+        case 'l':
+        case 'i':
+        case 'r':
+        case 't':
+        case 'w':
+        case 'X':
+        case 's':
+            /* Ignored: used by mkinit. */
+            break;
+
+        default:
+            usage();
+        }
+    }
+
+    num_files = argc - optind;
+    if (num_files <= 0) {
+        usage();
+    }
+
+    files = argv + optind;
+}
+
+static void
+usage(void)
+{
+    fputs("Usage: mkinit_erl [options] files...\n", stderr);
+    fputs("Options:\n", stderr);
+    fputs("  -c maxcalls:\t(ignored)\n", stderr);
+    fputs("  -g grade:\tset the grade of the executable\n", stderr);
+    fputs("  -i:\t\t(ignored)\n", stderr);
+    fputs("  -l:\t\t(ignored)\n", stderr);
+    fputs("  -o file:\toutput to the named file\n", stderr);
+    fputs("  -r word:\t(ignored)\n", stderr);
+    fputs("  -t:\t\t(ignored)\n", stderr);
+    fputs("  -w entry:\t(ignored)\n", stderr);
+    fputs("  -I dir:\tadd dir to the search path for init files\n", stderr);
+    fputs("  -k:\t\tgenerate the .init for a library\n", stderr);
+    fputs("  -s:\t\t(ignored)\n", stderr);
+    fputs("  -m:\t\tset the name of the module\n", stderr);
+    exit(EXIT_FAILURE);
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** If the `-o' option was used to specify the output file,
+** and the file name specified is not `-' (which we take to mean stdout),
+** then reassign stdout to the specified file.
+*/
+
+static void
+set_output_file(void)
+{
+    if (output_file_name != NULL) {
+        FILE *result = freopen(output_file_name, "w", stdout);
+        if (result == NULL) {
+            fprintf(stderr,
+                "%s: error opening output file `%s': %s\n",
+                MR_progname, output_file_name,
+                strerror(errno));
+            exit(EXIT_FAILURE);
+        }
+    }
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Scan the list of files for ones not found in the current directory,
+** and replace them with their full path equivalent if they are found
+** in the list of search directories.
+*/
+
+static void
+do_path_search(void)
+{
+    int     filenum;
+    char    *init_file;
+
+    for (filenum = 0; filenum < num_files; filenum++) {
+        init_file = find_init_file(files[filenum]);
+        if (init_file != NULL) {
+            files[filenum] = init_file;
+        }
+    }
+}
+
+/*
+** Search the init file directory list to locate the file.
+** If the file is in the current directory or is not in any of the
+** search directories, then return NULL.  Otherwise return the full
+** path name to the file.
+**
+** It is the caller's responsibility to free the returned buffer
+** holding the full path name when it is no longer needed.
+*/
+
+static char *
+find_init_file(const char *base_name)
+{
+    char        *filename;
+    char        *dirname;
+    String_List *dir_ptr;
+    int         dirlen;
+    int         baselen;
+    int         len;
+
+    if (file_exists(base_name)) {
+        /* File is in current directory, so no search required */
+        return NULL;
+    }
+
+    baselen = strlen(base_name);
+
+    for (dir_ptr = init_file_dirs; dir_ptr != NULL; dir_ptr = dir_ptr->next) {
+        dirname = dir_ptr->data;
+        dirlen = strlen(dirname);
+        len = dirlen + 1 + baselen;
+
+        filename = (char *) checked_malloc(len + 1);
+        strcpy(filename, dirname);
+        filename[dirlen] = '/';
+        strcpy(filename + dirlen + 1, base_name);
+
+        if (file_exists(filename)) {
+            return filename;
+        }
+
+        free(filename);
+    }
+
+    /* Did not find file */
+    return NULL;
+}
+
+/*
+** Check whether a file exists.
+*/
+
+static MR_bool
+file_exists(const char *filename)
+{
+#ifdef MR_HAVE_SYS_STAT_H
+    struct stat buf;
+
+    return (stat(filename, &buf) == 0);
+#else
+    FILE        *f;
+
+    f = fopen(filename, "rb");
+    if (f != NULL) {
+        fclose(f);
+        return MR_TRUE;
+    } else {
+        return MR_FALSE;
+    }
+#endif
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Read a line from a file, and return a pointer to a malloc'd buffer
+** holding the line (without the final newline). If EOF occurs on a
+** nonempty line, treat the EOF as a newline; if EOF occurs on an empty
+** line, return NULL.
+*/
+
+char *
+read_line(const char *filename, FILE *fp, int max)
+{
+    char    *buf;
+    int     c;
+    int     i;
+
+    buf = checked_malloc(max + 1);
+    i = 0;
+    while ((c = getc(fp)) != EOF && c != '\n') {
+        if (i >= max) {
+            fprintf(stderr, "%s: line too long in file `%s'\n",
+                MR_progname, filename);
+            num_errors++;
+            return NULL;
+        }
+
+        buf[i++] = c;
+    }
+
+    if (c == '\n' || i > 0) {
+        if (i >= max) {
+            fprintf(stderr, "%s: line too long in file `%s'\n",
+                MR_progname, filename);
+            num_errors++;
+            return NULL;
+        }
+
+        buf[i] = '\0';
+        return buf;
+    } else {
+        free(buf);
+        return NULL;
+    }
+}
+
+#define MAX_PROCNAME_LEN    1024
+
+static void
+output_headers(void)
+{
+    int filenum;
+
+    printf(header1, grade);
+
+    for (filenum = 0; filenum < num_files; filenum++) {
+        fputs("% ", stdout);
+        fputs(files[filenum], stdout);
+        putc('\n', stdout);
+    }
+}
+
+static void
+output_init_function(Purpose purpose, const char **func_names,
+    int num_func_names)
+{
+    int funcnum;
+
+    printf("%s() ->\n",
+        main_func_name[purpose]);
+
+    for (funcnum = 0; funcnum < num_func_names; funcnum++) {
+        printf("\t%s%s(),\n",
+            func_names[funcnum], module_suffix[purpose]);
+    }
+
+    fputs("\tvoid.\n", stdout);
+}
+
+/*---------------------------------------------------------------------------*/
+
+static void
+process_file(const char *filename)
+{
+    int len;
+
+    len = strlen(filename);
+    if (len >= 4 && strcmp(filename + len - 4, ".erl") == 0) {
+        process_init_file(filename, "% ");
+    } else if (len >= 5 && strcmp(filename + len - 5, ".init") == 0) {
+        process_init_file(filename, "");
+    } else {
+        fprintf(stderr,
+            "%s: filename `%s' must end in `.erl' or `.init'\n",
+            MR_progname, filename);
+        num_errors++;
+    }
+}
+
+static void
+process_init_file(const char *filename, const char *prefix_str)
+{
+    /*
+    ** The strings that are supposed to be followed by other information
+    ** (INIT, REQUIRED_INIT, and REQUIRED_FINAL) should end with
+    ** the space that separates the keyword from the following data.
+    ** The string that is not supposed to be following by other information
+    ** (ENDINIT) should not have a following space, since llds_out.m and
+    ** mlds_to_c.m do not add that space.
+    */
+
+    const char * const  init_str = "INIT ";
+    const char * const  reqinit_str = "REQUIRED_INIT ";
+    const char * const  reqfinal_str = "REQUIRED_FINAL ";
+    const char * const  envvar_str = "ENVVAR ";
+    const char * const  endinit_str = "ENDINIT";
+    const int           prefix_strlen = strlen(prefix_str);
+    const int           init_strlen = strlen(init_str);
+    const int           reqinit_strlen = strlen(reqinit_str);
+    const int           reqfinal_strlen = strlen(reqfinal_str);
+    const int           envvar_strlen = strlen(envvar_str);
+    const int           endinit_strlen = strlen(endinit_str);
+    char                line0[MAXLINE];
+    char *              line;
+    int                 len;
+    FILE                *cfile;
+
+    cfile = fopen(filename, "r");
+    if (cfile == NULL) {
+        fprintf(stderr, "%s: error opening file `%s': %s\n",
+            MR_progname, filename, strerror(errno));
+        num_errors++;
+        return;
+    }
+
+    while (get_line(cfile, line0, MAXLINE) > 0) {
+        if (strncmp(line0, prefix_str, prefix_strlen) != 0) {
+            continue;
+        }
+        line = line0 + prefix_strlen;
+
+        /* Remove trailing whitespace. */
+        len = strlen(line);
+        while (len > 0 && isspace(line[len - 1])) {
+            line[len - 1] = '\0';
+            len--;
+        }
+
+        if (strncmp(line, init_str, init_strlen) == 0) {
+            char    *func_name;
+            int     func_name_len;
+            int     j;
+            MR_bool special;
+
+            func_name = line + init_strlen;
+            func_name_len = strlen(func_name);
+            if (MR_strneq(&func_name[func_name_len - 4], "init", 4)) {
+                func_name[func_name_len - 4] = '\0';
+                MR_ensure_room_for_next(std_module, const char *,
+                    MR_INIT_STD_MODULE_SIZE);
+                std_modules[std_module_next] = checked_strdup(func_name);
+                std_module_next++;
+            } else {
+                MR_ensure_room_for_next(special_module, const char *,
+                    MR_INIT_SPECIAL_MODULE_SIZE);
+                special_modules[special_module_next] =
+                    checked_strdupcat(func_name, "_");
+                special_module_next++;
+            }
+        } else if (strncmp(line, reqinit_str, reqinit_strlen) == 0) {
+            char    *func_name;
+            int     j;
+
+            func_name = line + reqinit_strlen;
+            MR_ensure_room_for_next(req_init_module, const char *,
+                MR_INIT_REQ_MODULE_SIZE);
+            req_init_modules[req_init_module_next] = checked_strdup(func_name);
+            req_init_module_next++;
+        } else if (strncmp(line, reqfinal_str, reqfinal_strlen) == 0) {
+            char    *func_name;
+            int     j;
+
+            func_name = line + reqfinal_strlen;
+            MR_ensure_room_for_next(req_final_module, const char *,
+                MR_FINAL_REQ_MODULE_SIZE);
+            req_final_modules[req_final_module_next] =
+                checked_strdup(func_name);
+            req_final_module_next++;
+        } else if (strncmp(line, envvar_str, envvar_strlen) == 0) {
+            char    *envvar_name;
+            int     i;
+            int     j;
+            MR_bool found;
+
+            /*
+            ** Check that all characters in the name of the environment
+            ** variable are acceptable as components of a C variable name.
+            ** Note that the variable name doesn't have to start with a letter
+            ** because the variable name has a prefix.
+            */
+            for (j = envvar_strlen; MR_isalnumunder(line[j]); j++) {
+                /* VOID */
+            }
+
+            if (line[j] != '\n') {
+                printf("%s: error: bad environment variable name %s\n",
+                    MR_progname, line);
+            }
+
+            line[j] = '\0';     /* overwrite the newline */
+
+            envvar_name = line + envvar_strlen;
+
+            /*
+            ** Since the number of distinct environment variables used by
+            ** a program is likely to be in the single digits, linear search
+            ** should be efficient enough.
+            */
+            found = MR_FALSE;
+            for (i = 0; i < mercury_env_var_next; i++) {
+                if (strcmp(envvar_name, mercury_env_vars[i]) == 0) {
+                    found = MR_TRUE;
+                    break;
+                }
+            }
+
+            if (!found) {
+                MR_ensure_room_for_next(mercury_env_var, const char *,
+                    MR_ENV_VAR_LIST_SIZE);
+                mercury_env_vars[mercury_env_var_next] =
+                    checked_strdup(envvar_name);
+                mercury_env_var_next++;
+            }
+        } else if (strncmp(line, endinit_str, endinit_strlen) == 0) {
+            break;
+        }
+    }
+
+    fclose(cfile);
+}
+
+/*---------------------------------------------------------------------------*/
+
+static int
+get_line(FILE *file, char *line, int line_max)
+{
+    int c;
+    int num_chars;
+    int limit;
+
+    num_chars = 0;
+    limit = line_max - 2;
+    while ((c = getc(file)) != EOF && c != '\n') {
+        if (num_chars < limit) {
+            line[num_chars++] = c;
+        }
+    }
+
+    if (c == '\n' || num_chars > 0) {
+        line[num_chars++] = '\n';
+    }
+
+    line[num_chars] = '\0';
+
+#ifdef  CHECK_GET_LINE
+    if (check_fp != NULL) {
+        fprintf(check_fp, "%s", line);
+    }
+#endif
+
+    return num_chars;
+}
+
+/*---------------------------------------------------------------------------*/
+
+static void *
+checked_malloc(size_t size)
+{
+    void    *mem;
+
+    mem = malloc(size);
+    if (mem == NULL) {
+        fprintf(stderr, "Out of memory\n");
+        exit(EXIT_FAILURE);
+    }
+    return mem;
+}
+
+static char *
+checked_strdup(const char *str)
+{
+    char    *mem;
+
+    mem = malloc(strlen(str) + 1);
+    if (mem == NULL) {
+        fprintf(stderr, "Out of memory\n");
+        exit(EXIT_FAILURE);
+    }
+
+    strcpy(mem, str);
+    return mem;
+}
+
+static char *
+checked_strdupcat(const char *str, const char *suffix)
+{
+    char    *mem;
+
+    mem = malloc(strlen(str) + strlen(suffix) + 1);
+    if (mem == NULL) {
+        fprintf(stderr, "Out of memory\n");
+        exit(EXIT_FAILURE);
+    }
+
+    strcpy(mem, str);
+    strcat(mem, suffix);
+    return mem;
+}
+
+/*---------------------------------------------------------------------------*/
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list