[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