[m-rev.] for review: mmc --make for external foreign files improvements
Peter Ross
pro at missioncriticalit.com
Thu Dec 19 01:36:06 AEDT 2002
Hi,
For stayl to review.
This change is needed so that I can fix some of the review comments of
http://www.mercury.cs.mu.oz.au/mailing-lists/mercury-reviews/mercury-reviews.0212/0088.html
===================================================================
Estimated hours taken: 24
Branches: main
Change `mmc --make' so that it no longer builds the external foreign
object files at the same time as it builds the target object file.
This allows one to build on the IL backend where building an external
foreign file assembly depends on having all the imported Mercury
assemblies built first.
Various fixes were also added so that `mmc --make --grade il' could make
an executable.
compiler/compile_target_code.m:
Change il_assemble so that we always build a .dll version
irrespective of whether it contains main or not, as MC++ or C#
code may refer to the dll.
Add Mercury/dlls to the search path for the C# and MC++
compilers.
s,/,\\\\,g in the C# filename as the MS C# compiler doesn't
understand / as a directory seperator.
Add the referenced dlls to the C# compilers command line.
compiler/handle_options.m:
Fix a bug where copmute_grade incorrectly generated `hl.il'
instead of `il' as the grade name because we weren't always
considering the --target option.
compiler/make.m:
Add to the compilation_task_type type the alternatives
foreign_code_to_object_code and fact_table_foreign_code_file.
Add to the module_target_type type the alternatives
foreign_asm, foreign_object and factt_object.
compiler/make.dependencies.m:
Add code to handle the new module_target_type alternatives.
Add code to build the new alternatives to
compilation_task_type.
compiler/make.module_target.m:
Always create a directory to hold the target file before
building the target file.
compiler/make.program_target.m:
Determine the targets needed to be built for all the external
foreign files and add them to build target list.
compiler/make.util.m:
Add code to handle the new module_target_type alternatives.
Change write_target_file to output the correct name when
building the foreign_asm and foreign_object targets.
compiler/modules.m:
Move referenced_dlls into the interface for use by
`compile_target_code.m'.
Don't place dlls in a sub-directory because on the IL backend
the dlls are `part' of the executable file.
tests/hard_coded/foreign_proc_make.exp:
tests/hard_coded/foreign_proc_make.m:
tests/hard_coded/foreign_proc_make2.m:
Add a test case.
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.31
diff -u -r1.31 compile_target_code.m
--- compiler/compile_target_code.m 3 Dec 2002 08:41:56 -0000 1.31
+++ compiler/compile_target_code.m 18 Dec 2002 14:04:41 -0000
@@ -65,9 +65,9 @@
:- mode compile_managed_cplusplus_file(in, in, in, out, di, uo) is det.
% compile_csharp_file(ErrorStream, C#File, DLLFile, Succeeded).
-:- pred compile_csharp_file(io__output_stream, file_name, file_name,
- bool, io__state, io__state).
-:- mode compile_csharp_file(in, in, in, out, di, uo) is det.
+:- pred compile_csharp_file(io__output_stream, module_imports,
+ file_name, file_name, bool, io__state, io__state).
+:- mode compile_csharp_file(in, in, in, in, out, di, uo) is det.
% make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded).
%
@@ -152,16 +152,24 @@
:- import_module char, dir, getopt, int, require, string.
-il_assemble(ErrorStream, ModuleName,
- HasMain, Succeeded) -->
+il_assemble(ErrorStream, ModuleName, HasMain, Succeeded) -->
module_name_to_file_name(ModuleName, ".il", no, IL_File),
+ module_name_to_file_name(ModuleName, ".dll", yes, DllFile),
+
+ %
+ % If the module contains main/2 then we it should be built as an
+ % executable. Unfortunately MC++ or C# code may refer to the dll
+ % so we always need to build the dll.
+ %
+ il_assemble(ErrorStream, IL_File, DllFile, no_main, DllSucceeded),
( { HasMain = has_main } ->
- module_name_to_file_name(ModuleName, ".exe", yes, TargetFile)
+ module_name_to_file_name(ModuleName, ".exe", yes, ExeFile),
+ il_assemble(ErrorStream, IL_File, ExeFile,
+ HasMain, ExeSucceeded),
+ { Succeeded = DllSucceeded `and` ExeSucceeded }
;
- module_name_to_file_name(ModuleName, ".dll", yes, TargetFile)
- ),
- il_assemble(ErrorStream, IL_File, TargetFile,
- HasMain, Succeeded).
+ { Succeeded = DllSucceeded }
+ ).
il_assemble(ErrorStream, IL_File, TargetFile,
HasMain, Succeeded) -->
@@ -225,8 +233,9 @@
% XXX Should we use a separate dll_directories options?
globals__io_lookup_accumulating_option(link_library_directories,
DLLDirs),
- { DLLDirOpts = string__append_list(list__condense(list__map(
- (func(DLLDir) = ["-AI", DLLDir, " "]), DLLDirs))) },
+ { DLLDirOpts = "-AIMercury/dlls " ++
+ string__append_list(list__condense(list__map(
+ (func(DLLDir) = ["-AI", DLLDir, " "]), DLLDirs))) },
{ string__append_list([MCPP, " -CLR ", DebugOpt, InclOpts,
DLLDirOpts, MCPPFlags, " ", MCPPFileName,
@@ -235,8 +244,8 @@
invoke_system_command(ErrorStream, verbose_commands,
Command, Succeeded).
-compile_csharp_file(ErrorStream,
- CSharpFileName, DLLFileName, Succeeded) -->
+compile_csharp_file(ErrorStream, Imports,
+ CSharpFileName0, DLLFileName, Succeeded) -->
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Compiling `"),
maybe_write_string(Verbose, CSharpFileName),
@@ -244,6 +253,11 @@
globals__io_lookup_string_option(csharp_compiler, CSC),
globals__io_lookup_accumulating_option(csharp_flags, CSCFlagsList),
{ join_string_list(CSCFlagsList, "", "", " ", CSCFlags) },
+
+ % XXX This is because the MS C# compiler doesn't understand
+ % / as a directory seperator.
+ { CSharpFileName = string__replace_all(CSharpFileName0, "/", "\\\\") },
+
globals__io_lookup_bool_option(target_debug, Debug),
{ Debug = yes ->
% XXX This needs testing before it can be enabled
@@ -258,11 +272,26 @@
% XXX Should we use a separate dll_directories options?
globals__io_lookup_accumulating_option(link_library_directories,
DLLDirs),
- { DLLDirOpts = string__append_list(list__condense(list__map(
- (func(DLLDir) = ["/lib:", DLLDir, " "]), DLLDirs))) },
+ { DLLDirOpts = "/lib:Mercury/dlls " ++
+ string__append_list(list__condense(list__map(
+ (func(DLLDir) = ["/lib:", DLLDir, " "]), DLLDirs))) },
+
+ { mercury_std_library_module_name(Imports ^ module_name) ->
+ Prefix = "/addmodule:"
+ ;
+ Prefix = "/r:"
+ },
+ { ReferencedDlls = referenced_dlls(Imports ^ module_name,
+ Imports ^ int_deps ++ Imports ^ impl_deps) },
+ list__map_foldl((pred(Mod::in, Result::out, di, uo) is det -->
+ module_name_to_file_name(Mod, ".dll", no, FileName),
+ { Result = [Prefix, FileName, " "] }
+ ), ReferencedDlls, ReferencedDllsList),
+ { ReferencedDllsStr = string__append_list(
+ list__condense(ReferencedDllsList)) },
- { string__append_list([CSC, " -CLR ", DebugOpt,
- "/t:library ", DLLDirOpts, CSCFlags,
+ { string__append_list([CSC, DebugOpt,
+ " /t:library ", DLLDirOpts, CSCFlags, ReferencedDllsStr,
" /out:", DLLFileName, " ", CSharpFileName], Command) },
invoke_system_command(ErrorStream, verbose_commands,
Command, Succeeded).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.160
diff -u -r1.160 handle_options.m
--- compiler/handle_options.m 13 Nov 2002 06:14:58 -0000 1.160
+++ compiler/handle_options.m 18 Dec 2002 14:04:41 -0000
@@ -1323,12 +1323,21 @@
set__init(NoComps),
list__foldl2(lambda([CompStr::in, Opts0::in, Opts::out,
CompSet0::in, CompSet::out] is semidet, (
- grade_component_table(CompStr, Comp, CompOpts),
+ grade_component_table(CompStr, Comp, CompOpts, MaybeTargets),
% Check that the component isn't mentioned
% more than once.
\+ set__member(Comp, CompSet0),
set__insert(CompSet0, Comp, CompSet),
- add_option_list(CompOpts, Opts0, Opts)
+ add_option_list(CompOpts, Opts0, Opts1),
+
+ % XXX Here the behaviour matches what used to happen
+ % and that is to only set the target option iff there
+ % was only one possible target. Is this a bug?
+ ( MaybeTargets = yes([Target]) ->
+ add_option_list([target - Target], Opts1, Opts)
+ ;
+ Opts = Opts1
+ )
)), Components, Options1, Options, NoComps, _FinalComps).
:- pred add_option_list(list(pair(option, option_data)), option_table,
@@ -1391,7 +1400,7 @@
compute_grade_components(Options, GradeComponents) :-
solutions(lambda([CompData::out] is nondet, (
- grade_component_table(Name, Comp, CompOpts),
+ grade_component_table(Name, Comp, CompOpts, MaybeTargets),
% For possible component of the grade string
% include it in the actual grade string if all
% the option setting that it implies are true.
@@ -1404,14 +1413,25 @@
list__member(Opt - Value, CompOpts),
\+ map__search(Options, Opt, Value)
),
+
+ % When checking gcc_ext there exist grades which
+ % can have more then one possible target, ensure that
+ % the target in the options table matches one of the
+ % possible targets.
+ ( MaybeTargets = yes(Targets) ->
+ list__member(Target, Targets),
+ map__search(Options, target, Target)
+ ;
+ true
+ ),
CompData = Comp - Name
)), GradeComponents).
:- pred grade_component_table(string, grade_component,
- list(pair(option, option_data))).
-:- mode grade_component_table(in, out, out) is semidet.
-:- mode grade_component_table(out, in, out) is multi.
-:- mode grade_component_table(out, out, out) is multi.
+ list(pair(option, option_data)), maybe(list(option_data))).
+:- mode grade_component_table(in, out, out, out) is semidet.
+:- mode grade_component_table(out, in, out, out) is multi.
+:- mode grade_component_table(out, out, out, out) is multi.
% Base components
% These specify the basic compilation model we use,
@@ -1422,162 +1442,158 @@
gcc_global_registers - bool(no),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("reg", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(yes),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("jump", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(yes),
gcc_global_registers - bool(no),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("asm_jump", gcc_ext, [
asm_labels - bool(yes),
gcc_non_local_gotos - bool(yes),
gcc_global_registers - bool(no),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("fast", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(yes),
gcc_global_registers - bool(yes),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("asm_fast", gcc_ext, [
asm_labels - bool(yes),
gcc_non_local_gotos - bool(yes),
gcc_global_registers - bool(yes),
highlevel_code - bool(no),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("c")]).
+ highlevel_data - bool(no)],
+ yes([string("c")])).
grade_component_table("hl", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(no),
- highlevel_data - bool(yes)
- % target can be either c or asm
- ]).
+ highlevel_data - bool(yes)],
+ yes([string("c"), string("asm")])).
grade_component_table("hlc", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no)
- % target can be either c or asm
- ]).
+ highlevel_data - bool(no)],
+ yes([string("c"), string("asm")])).
grade_component_table("hl_nest", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(yes),
- highlevel_data - bool(yes)
- % target can be either c or asm
- ]).
+ highlevel_data - bool(yes)],
+ yes([string("c"), string("asm")])).
grade_component_table("hlc_nest", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(yes),
- highlevel_data - bool(no)
- % target can be either c or asm
- ]).
+ highlevel_data - bool(no)],
+ yes([string("c"), string("asm")])).
grade_component_table("il", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(no),
- highlevel_data - bool(yes),
- target - string("il")]).
+ highlevel_data - bool(yes)],
+ yes([string("il")])).
grade_component_table("ilc", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
highlevel_code - bool(yes),
gcc_nested_functions - bool(no),
- highlevel_data - bool(no),
- target - string("il")]).
+ highlevel_data - bool(no)],
+ yes([string("il")])).
grade_component_table("java", gcc_ext, [
asm_labels - bool(no),
gcc_non_local_gotos - bool(no),
gcc_global_registers - bool(no),
gcc_nested_functions - bool(no),
highlevel_code - bool(yes),
- highlevel_data - bool(yes),
- target - string("java")]).
+ highlevel_data - bool(yes)],
+ yes([string("java")])).
% Parallelism/multithreading components.
-grade_component_table("par", par, [parallel - bool(yes)]).
+grade_component_table("par", par, [parallel - bool(yes)], no).
% GC components
-grade_component_table("gc", gc, [gc - string("boehm")]).
-grade_component_table("mps", gc, [gc - string("mps")]).
-grade_component_table("agc", gc, [gc - string("accurate")]).
+grade_component_table("gc", gc, [gc - string("boehm")], no).
+grade_component_table("mps", gc, [gc - string("mps")], no).
+grade_component_table("agc", gc, [gc - string("accurate")], no).
% Profiling components
grade_component_table("prof", prof,
[profile_time - bool(yes), profile_calls - bool(yes),
- profile_memory - bool(no), profile_deep - bool(no)]).
+ profile_memory - bool(no), profile_deep - bool(no)], no).
grade_component_table("proftime", prof,
[profile_time - bool(yes), profile_calls - bool(no),
- profile_memory - bool(no), profile_deep - bool(no)]).
+ profile_memory - bool(no), profile_deep - bool(no)], no).
grade_component_table("profcalls", prof,
[profile_time - bool(no), profile_calls - bool(yes),
- profile_memory - bool(no), profile_deep - bool(no)]).
+ profile_memory - bool(no), profile_deep - bool(no)], no).
grade_component_table("memprof", prof,
[profile_time - bool(no), profile_calls - bool(yes),
- profile_memory - bool(yes), profile_deep - bool(no)]).
+ profile_memory - bool(yes), profile_deep - bool(no)], no).
grade_component_table("profall", prof,
[profile_time - bool(yes), profile_calls - bool(yes),
- profile_memory - bool(yes), profile_deep - bool(no)]).
+ profile_memory - bool(yes), profile_deep - bool(no)], no).
grade_component_table("profdeep", prof,
[profile_time - bool(no), profile_calls - bool(no),
- profile_memory - bool(no), profile_deep - bool(yes)]).
+ profile_memory - bool(no), profile_deep - bool(yes)], no).
% Trailing components
-grade_component_table("tr", trail, [use_trail - bool(yes)]).
+grade_component_table("tr", trail, [use_trail - bool(yes)], no).
% Tag reservation components
-grade_component_table("rt", tag, [reserve_tag - bool(yes)]).
+grade_component_table("rt", tag, [reserve_tag - bool(yes)], no).
% Mimimal model tabling components
-grade_component_table("mm", minimal_model, [use_minimal_model - bool(yes)]).
+grade_component_table("mm", minimal_model, [use_minimal_model - bool(yes)], no).
% Pic reg components
-grade_component_table("picreg", pic, [pic_reg - bool(yes)]).
+grade_component_table("picreg", pic, [pic_reg - bool(yes)], no).
% Debugging/Tracing components
grade_component_table("decldebug", trace,
[stack_trace - bool(yes), require_tracing - bool(yes),
- decl_debug - bool(yes)]).
+ decl_debug - bool(yes)], no).
grade_component_table("debug", trace,
[stack_trace - bool(yes), require_tracing - bool(yes),
- decl_debug - bool(no)]).
+ decl_debug - bool(no)], no).
grade_component_table("trace", trace,
[stack_trace - bool(no), require_tracing - bool(yes),
- decl_debug - bool(no)]).
+ decl_debug - bool(no)], no).
grade_component_table("strce", trace,
[stack_trace - bool(yes), require_tracing - bool(no),
- decl_debug - bool(no)]).
+ decl_debug - bool(no)], no).
:- pred reset_grade_options(option_table, option_table).
:- mode reset_grade_options(in, out) is det.
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.10
diff -u -r1.10 make.dependencies.m
--- compiler/make.dependencies.m 30 Oct 2002 13:31:48 -0000 1.10
+++ compiler/make.dependencies.m 18 Dec 2002 14:04:41 -0000
@@ -189,6 +189,25 @@
long_interface `of` non_intermod_direct_imports,
short_interface `of` non_intermod_indirect_imports
]).
+target_dependencies(_, foreign_asm(_)) =
+ combine_deps_list([
+ il_asm `of` self,
+ il_asm `of` filter(maybe_keep_std_lib_module, direct_imports)
+ ]).
+target_dependencies(Globals, foreign_object(PIC, _)) =
+ get_foreign_deps(Globals, PIC).
+target_dependencies(Globals, factt_object(PIC)) =
+ get_foreign_deps(Globals, PIC).
+
+:- func get_foreign_deps(globals, pic) = find_module_deps(dependency_file).
+:- mode get_foreign_deps(in, in) = out(find_module_deps) is det.
+
+get_foreign_deps(Globals, PIC) = Deps :-
+ globals__get_target(Globals, CompilationTarget),
+ TargetCode = ( CompilationTarget = asm -> asm_code(PIC) ; c_code ),
+ Deps = combine_deps_list([
+ TargetCode `of` self
+ ]).
:- func interface_file_dependencies =
(find_module_deps(dependency_file)::out(find_module_deps)) is det.
@@ -561,6 +580,42 @@
%-----------------------------------------------------------------------------%
+%
+% filter(F, P, MN, S, Ms, I0, I, IO0, IO)
+% Filter the set of module_names returned from P called with MN, I0, IO0
+% as its input arguments with F. The first argument to F will be MN.
+% and the second argument the
+%
+:- pred filter(pred(module_name, module_name)::pred(in, in) is semidet,
+ pred(module_name, bool, set(module_name), make_info, make_info,
+ io, io)::pred(in, out, out, in, out, di, uo) is det,
+ module_name::in, bool::out,
+ set(module_name)::out, make_info::in, make_info::out,
+ io::di, io::uo) is det.
+
+filter(Filter, F, ModuleName, Success, Modules, !Info) -->
+ F(ModuleName, Success, Modules0, !Info),
+ { Modules = set__filter(
+ (pred(M::in) is semidet :-
+ Filter(ModuleName, M)
+ ), Modules0) }.
+
+%
+% If the current module we are compiling is not in the standard library
+% and the module we are importing is then remove it, otherwise keep it.
+% This is because in the removal case we need to import mercury.dll instead.
+%
+:- pred maybe_keep_std_lib_module(module_name::in,
+ module_name::in) is semidet.
+
+maybe_keep_std_lib_module(CurrentModule, ImportedModule) :-
+ \+ (
+ \+ mercury_std_library_module_name(CurrentModule),
+ mercury_std_library_module_name(ImportedModule)
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred fact_table(module_name::in,
bool::out, set(pair(file_name, maybe(option)))::out,
make_info::in, make_info::out, io__state::di, io__state::uo) is det.
@@ -931,5 +986,10 @@
),
{ Info = Info2 ^ dependency_status ^ elem(Dep) := Status }
).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "make.dependencies.m".
%-----------------------------------------------------------------------------%
Index: compiler/make.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.m,v
retrieving revision 1.13
diff -u -r1.13 make.m
--- compiler/make.m 30 Oct 2002 13:31:48 -0000 1.13
+++ compiler/make.m 18 Dec 2002 14:04:41 -0000
@@ -57,6 +57,7 @@
:- import_module backend_libs__foreign, backend_libs__compile_target_code.
:- import_module libs__timestamp, libs__process_util.
:- import_module libs__globals, libs__options, libs__handle_options.
+:- import_module hlds__error_util.
:- import_module top_level__mercury_compile. % XXX unwanted dependency
:- import_module assoc_list, bool, char, dir, exception, getopt, int, list.
@@ -126,6 +127,8 @@
% The `pic' argument is only used for
% `--target c' and `--target asm'.
; target_code_to_object_code(pic)
+ ; foreign_code_to_object_code(pic, foreign_language)
+ ; fact_table_code_to_object_code(pic)
.
:- type module_compilation_task_type
@@ -154,6 +157,9 @@
; java_code
; asm_code(pic)
; object_code(pic)
+ ; foreign_asm(foreign_language)
+ ; foreign_object(pic, foreign_language)
+ ; factt_object(pic)
.
:- type c_header_type
Index: compiler/make.module_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.module_target.m,v
retrieving revision 1.18
diff -u -r1.18 make.module_target.m
--- compiler/make.module_target.m 29 Nov 2002 12:01:12 -0000 1.18
+++ compiler/make.module_target.m 18 Dec 2002 14:04:41 -0000
@@ -241,6 +241,7 @@
build_target(CompilationTask, TargetFile, Imports, TouchedTargetFiles,
TouchedFiles, Succeeded, Info0, Info) -->
maybe_make_target_message(TargetFile),
+ maybe_make_directory_for_target_file(TargetFile),
{ TargetFile = ModuleName - _FileType },
{ CompilationTask = Task - TaskOptions },
{ Cleanup =
@@ -312,19 +313,37 @@
).
build_target_2(ModuleName, target_code_to_object_code(PIC),
- Imports, _, ErrorStream, Succeeded, Info0, Info) -->
- get_target_code_to_object_code_foreign_files(ModuleName,
- ForeignCodeFiles, Info0, Info),
+ Imports, _, ErrorStream, Succeeded, Info, Info) -->
globals__io_get_target(CompilationTarget),
+ % Run the compilation in a child process so it can
+ % be killed if an interrupt arrives.
+ call_in_forked_process(
+ build_object_code(ModuleName, CompilationTarget, PIC,
+ ErrorStream, Imports),
+ Succeeded).
+
+build_target_2(ModuleName, foreign_code_to_object_code(PIC, Lang),
+ Imports, _, ErrorStream, Succeeded, Info, Info) -->
+ foreign_code_file(ModuleName, PIC, Lang, ForeignCodeFile),
+
+ % Run the compilation in a child process so it can
+ % be killed if an interrupt arrives.
+ call_in_forked_process(
+ compile_foreign_code_file(ErrorStream, PIC,
+ Imports, ForeignCodeFile),
+ Succeeded).
+
+build_target_2(ModuleName, fact_table_code_to_object_code(PIC),
+ Imports, _, ErrorStream, Succeeded, Info, Info) -->
+ list__map_foldl(fact_table_foreign_code_file(ModuleName, PIC),
+ Imports ^ fact_table_deps, FactTableForeignCodes),
{ CompileTargetCode =
(pred(Succeeded1::out, di, uo) is det -->
- build_object_code(ModuleName, CompilationTarget, PIC,
- ErrorStream, Imports, Succeeded0),
- list__map_foldl(compile_foreign_code_file(ErrorStream, PIC),
- ForeignCodeFiles, ForeignCodeSucceeded),
+ list__map_foldl(compile_foreign_code_file(ErrorStream, PIC,
+ Imports),
+ FactTableForeignCodes, ForeignCodeSucceeded),
{
- Succeeded0 = yes,
\+ list__member(no, ForeignCodeSucceeded)
->
Succeeded1 = yes
@@ -333,11 +352,9 @@
}
) },
-
% Run the compilation in a child process so it can
% be killed if an interrupt arrives.
- call_in_forked_process(CompileTargetCode,
- CompileTargetCode, Succeeded).
+ call_in_forked_process(CompileTargetCode, Succeeded).
:- pred build_object_code(module_name::in, compilation_target::in, pic::in,
io__output_stream::in, module_imports::in, bool::out,
@@ -357,27 +374,102 @@
Imports ^ has_main, Succeeded).
:- pred compile_foreign_code_file(io__output_stream::in, pic::in,
- foreign_code_file::in, bool::out, io__state::di, io__state::uo) is det.
+ module_imports::in, foreign_code_file::in, bool::out,
+ io__state::di, io__state::uo) is det.
-compile_foreign_code_file(ErrorStream, PIC,
+compile_foreign_code_file(ErrorStream, PIC, _Imports,
foreign_code_file(c, CFile, ObjFile), Succeeded) -->
compile_target_code__compile_c_file(ErrorStream, PIC,
CFile, ObjFile, Succeeded).
-compile_foreign_code_file(ErrorStream, _,
+compile_foreign_code_file(ErrorStream, _, _Imports,
foreign_code_file(il, ILFile, DLLFile), Succeeded) -->
compile_target_code__il_assemble(ErrorStream, ILFile, DLLFile,
no_main, Succeeded).
-compile_foreign_code_file(ErrorStream, _,
+compile_foreign_code_file(ErrorStream, _, _Imports,
foreign_code_file(managed_cplusplus, MCPPFile, DLLFile),
Succeeded) -->
compile_target_code__compile_managed_cplusplus_file(ErrorStream,
MCPPFile, DLLFile, Succeeded).
-compile_foreign_code_file(ErrorStream, _,
+compile_foreign_code_file(ErrorStream, _, Imports,
foreign_code_file(csharp, CSharpFile, DLLFile),
Succeeded) -->
- compile_target_code__compile_csharp_file(ErrorStream,
+ compile_target_code__compile_csharp_file(ErrorStream, Imports,
CSharpFile, DLLFile, Succeeded).
+:- pred foreign_code_file(module_name::in, pic::in, foreign_language::in,
+ foreign_code_file::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_make_directory_for_target_file(target_file::in,
+ io::di, io::uo) is det.
+
+maybe_make_directory_for_target_file(_ModuleName - TargetType) -->
+ globals__io_get_globals(Globals),
+ { Extension = target_extension(Globals, TargetType) },
+ { string__first_char(Extension, '.', Ext0) ->
+ Ext = Ext0
+ ;
+ unexpected(this_file, "extension doesn't have leading '.'")
+ },
+ make_directory("Mercury/" ++ Ext ++ "s").
+
+%-----------------------------------------------------------------------------%
+
+foreign_code_file(ModuleName, PIC, Lang, ForeignCodeFile) -->
+ globals__io_get_globals(Globals),
+ {
+ ForeignModName0 = foreign_language_module_name(
+ ModuleName, Lang),
+ SrcExt0 = foreign_language_file_extension(Lang)
+ ->
+ ForeignModName = ForeignModName0,
+ SrcExt = SrcExt0
+ ;
+ unexpected(this_file, "unsupported foreign language")
+ },
+ { ObjExt = get_object_extension(Globals, PIC) },
+ module_name_to_file_name(ForeignModName, SrcExt, yes, SrcFileName),
+ module_name_to_file_name(ForeignModName, ObjExt, yes, ObjFileName),
+ { ForeignCodeFile = foreign_code_file(Lang, SrcFileName, ObjFileName) }.
+
+:- pred fact_table_foreign_code_file(module_name::in, pic::in, string::in,
+ foreign_code_file::out, io::di, io::uo) is det.
+
+fact_table_foreign_code_file(ModuleName, PIC, FactTableName,
+ ForeignCodeFile) -->
+ globals__io_get_globals(Globals),
+ { ObjExt = get_object_extension(Globals, PIC) },
+ fact_table_file_name(ModuleName, FactTableName, ".c", CFile),
+ fact_table_file_name(ModuleName, FactTableName, ObjExt, ObjFile),
+ { ForeignCodeFile = foreign_code_file(c, CFile, ObjFile) }.
+
+:- func get_object_extension(globals, pic) = string.
+
+get_object_extension(Globals, PIC) = Ext :-
+ globals__get_target(Globals, CompilationTarget),
+ ( CompilationTarget = c,
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ )
+ ; CompilationTarget = asm,
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ )
+ ; CompilationTarget = il,
+ Ext = ".dll"
+ ; CompilationTarget = java,
+ sorry(this_file, "object extension for java")
+ ).
+
%-----------------------------------------------------------------------------%
:- pred call_mercury_compile_main(list(string)::in, bool::out,
@@ -480,13 +572,23 @@
process_module(compile_to_target_code) -
( PIC = pic -> ["--pic"] ; [] ).
compilation_task(Globals, object_code(PIC)) =
- target_code_to_object_code(PIC) - Flags :-
- globals__get_target(Globals, Target),
- ( PIC = pic ->
- Flags = ( Target = asm -> ["--pic"] ; ["--pic-reg"] )
- ;
- Flags = []
- ).
+ target_code_to_object_code(PIC) - get_pic_flags(Globals, PIC).
+compilation_task(_, foreign_asm(Lang)) =
+ foreign_code_to_object_code(non_pic, Lang) - [].
+compilation_task(Globals, foreign_object(PIC, Lang)) =
+ foreign_code_to_object_code(PIC, Lang) - get_pic_flags(Globals, PIC).
+compilation_task(Globals, factt_object(PIC)) =
+ fact_table_code_to_object_code(PIC) - get_pic_flags(Globals, PIC).
+
+:- func get_pic_flags(globals, pic) = list(string).
+
+get_pic_flags(Globals, PIC) = Flags :-
+ globals__get_target(Globals, Target),
+ ( PIC = pic ->
+ Flags = ( Target = asm -> ["--pic"] ; ["--pic-reg"] )
+ ;
+ Flags = []
+ ).
% Find the files which could be touched by a compilation task.
:- pred touched_files(target_file::in, compilation_task_type::in,
@@ -630,13 +732,32 @@
TimestampFileNames]) }.
touched_files(TargetFile, target_code_to_object_code(_),
+ [TargetFile], [], Info, Info) -->
+ [].
+
+touched_files(TargetFile, foreign_code_to_object_code(PIC, Lang),
+ [TargetFile], [ForeignObjectFile], Info, Info) -->
+ { TargetFile = ModuleName - _ },
+ foreign_code_file(ModuleName, PIC, Lang, ForeignCodeFile),
+ { ForeignObjectFile = ForeignCodeFile ^ object_file }.
+
+touched_files(TargetFile, fact_table_code_to_object_code(PIC),
[TargetFile], ForeignObjectFiles, Info0, Info) -->
{ TargetFile = ModuleName - _ },
- get_target_code_to_object_code_foreign_files(ModuleName,
- ForeignCodeFileList, Info0, Info),
- { ForeignObjectFiles = list__map(
- (func(ForeignFile) = ForeignFile ^ object_file),
- ForeignCodeFileList) }.
+ get_module_dependencies(ModuleName, MaybeImports, Info0, Info),
+ { MaybeImports = yes(Imports0) ->
+ Imports = Imports0
+ ;
+ % This error should have been caught earlier.
+ % We shouldn't be attempting to build a target
+ % if we couldn't find the dependencies for the
+ % module.
+ unexpected(this_file, "touched_files: no module dependencies")
+ },
+ list__map_foldl(fact_table_foreign_code_file(ModuleName, PIC),
+ Imports ^ fact_table_deps, FactTableForeignCodes),
+ { ForeignObjectFiles = list__map((func(F) = F ^ object_file),
+ FactTableForeignCodes) }.
:- pred get_target_code_to_object_code_foreign_files(module_name::in,
list(foreign_code_file)::out, make_info::in, make_info::out,
@@ -761,5 +882,10 @@
% No external file is generated for this foreign language.
{ ForeignFiles = [] }
).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "make.module_target.m".
%-----------------------------------------------------------------------------%
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.15
diff -u -r1.15 make.program_target.m
--- compiler/make.program_target.m 31 Oct 2002 14:47:01 -0000 1.15
+++ compiler/make.program_target.m 18 Dec 2002 14:04:41 -0000
@@ -33,13 +33,12 @@
:- import_module hlds__passes_aux.
-make_linked_target(MainModuleName - FileType, Succeeded, Info0, Info) -->
+make_linked_target(MainModuleName - FileType, Succeeded, !Info) -->
find_reachable_local_modules(MainModuleName, DepsSuccess,
- AllModules, Info0, Info1),
+ AllModules, !Info),
globals__io_lookup_bool_option(keep_going, KeepGoing),
( { DepsSuccess = no, KeepGoing = no } ->
- { Succeeded = no },
- { Info = Info1 }
+ { Succeeded = no }
;
globals__io_lookup_string_option(pic_object_file_extension, PicObjExt),
globals__io_lookup_string_option(object_file_extension, ObjExt),
@@ -76,21 +75,25 @@
},
get_target_modules(IntermediateTargetType,
- set__to_sorted_list(AllModules), ObjModules, Info1, Info4),
+ set__to_sorted_list(AllModules), ObjModules, !Info),
{ IntermediateTargets = make_dependency_list(ObjModules,
IntermediateTargetType) },
{ ObjTargets = make_dependency_list(ObjModules, ObjectTargetType) },
+ list__map_foldl2(get_foreign_object_targets(ObjectCodeType),
+ ObjModules, ForeignObjTargetsList, !Info),
+ { ForeignObjTargets = list__condense(ForeignObjTargetsList) },
+
foldl2_maybe_stop_at_error(KeepGoing,
foldl2_maybe_stop_at_error(KeepGoing, make_module_target),
- [IntermediateTargets, ObjTargets], BuildDepsSucceeded,
- Info4, Info5),
+ [IntermediateTargets, ObjTargets, ForeignObjTargets],
+ BuildDepsSucceeded, !Info),
linked_target_file_name(MainModuleName, FileType, OutputFileName),
get_file_timestamp([dir__this_directory], OutputFileName,
- MaybeTimestamp, Info5, Info6),
+ MaybeTimestamp, !Info),
check_dependencies(OutputFileName, MaybeTimestamp, BuildDepsSucceeded,
- ObjTargets, BuildDepsResult, Info6, Info7),
+ ObjTargets, BuildDepsResult, !Info),
(
{ DepsSuccess = yes },
@@ -105,10 +108,9 @@
DepsSuccess, BuildDepsResult)),
linked_target_cleanup(MainModuleName, FileType, OutputFileName,
CompilationTarget),
- Succeeded, Info7, Info)
+ Succeeded, !Info)
;
- { Succeeded = no },
- { Info = Info7 }
+ { Succeeded = no }
)
).
@@ -150,6 +152,56 @@
{ TargetModules = AllModules }
).
+:- pred get_foreign_object_targets(pic::in,
+ module_name::in, list(dependency_file)::out,
+ make_info::in, make_info::out, io::di, io::uo) is det.
+
+get_foreign_object_targets(PIC, ModuleName, ObjectTargets, !Info) -->
+ %
+ % Find externally compiled foreign code files for
+ % `:- pragma foreign_proc' declarations.
+ %
+ globals__io_get_target(CompilationTarget),
+ get_module_dependencies(ModuleName, MaybeImports, !Info),
+ { MaybeImports = yes(Imports)
+ ; MaybeImports = no,
+ unexpected(this_file, "unknown imports")
+ },
+ (
+ { CompilationTarget = asm },
+ { Imports ^ foreign_code = contains_foreign_code(Langs) },
+ { set__member(c, Langs) }
+ ->
+ { ForeignObjectTargets = [
+ target(ModuleName - foreign_object(PIC, c))] }
+ ;
+ { CompilationTarget = il },
+ { Imports ^ foreign_code = contains_foreign_code(Langs) }
+ ->
+ { ForeignObjectTargets = list__map(
+ (func(L) =
+ target(ModuleName - foreign_asm(L))
+ ), set__to_sorted_list(Langs)) }
+ ;
+ { ForeignObjectTargets = [] }
+ ),
+
+ %
+ % Find out if any externally compiled foreign code files for fact
+ % tables exist.
+ %
+ ( { CompilationTarget = c ; CompilationTarget = asm } ->
+ { Imports ^ fact_table_deps \= [] ->
+ ObjectTargets = [target(ModuleName - factt_object(PIC))
+ | ForeignObjectTargets]
+ ;
+ ObjectTargets = ForeignObjectTargets
+ }
+ ;
+ { ObjectTargets = ForeignObjectTargets }
+ ).
+
+
:- pred build_linked_target(module_name::in, linked_target_type::in,
file_name::in, maybe_error(timestamp)::in, set(module_name)::in,
list(module_name)::in, compilation_target::in, string::in, bool::in,
@@ -927,5 +979,10 @@
],
Info1, Info2),
remove_file(ModuleName, module_dep_file_extension, Info2, Info).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "make.program_target.m".
%-----------------------------------------------------------------------------%
Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.10
diff -u -r1.10 make.util.m
--- compiler/make.util.m 30 Oct 2002 13:31:49 -0000 1.10
+++ compiler/make.util.m 18 Dec 2002 14:04:42 -0000
@@ -625,6 +625,46 @@
globals__lookup_string_option(Globals, object_file_extension, Ext).
target_extension(Globals, object_code(pic)) = Ext :-
globals__lookup_string_option(Globals, pic_object_file_extension, Ext).
+target_extension(Globals, foreign_object(PIC, c)) = Ext :-
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ ).
+target_extension(Globals, foreign_object(PIC, csharp)) = Ext :-
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ ).
+target_extension(Globals, foreign_object(PIC, managed_cplusplus)) = Ext :-
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ ).
+target_extension(Globals, foreign_object(PIC, il)) = Ext :-
+ ( PIC = non_pic,
+ globals__lookup_string_option(Globals,
+ object_file_extension, Ext)
+ ; PIC = pic,
+ globals__lookup_string_option(Globals,
+ pic_object_file_extension, Ext)
+ ).
+target_extension(_, foreign_asm(c)) = ".dll".
+target_extension(_, foreign_asm(csharp)) = ".dll".
+target_extension(_, foreign_asm(managed_cplusplus)) = ".dll".
+target_extension(_, foreign_asm(il)) = ".dll".
+target_extension(Globals, factt_object(non_pic)) = Ext :-
+ globals__lookup_string_option(Globals, object_file_extension, Ext).
+target_extension(Globals, factt_object(pic)) = Ext :-
+ globals__lookup_string_option(Globals, pic_object_file_extension, Ext).
linked_target_file_name(ModuleName, executable, FileName) -->
globals__io_lookup_string_option(executable_file_extension, Ext),
@@ -673,6 +713,9 @@
search_for_file_type(java_code) = no.
search_for_file_type(asm_code(_)) = no.
search_for_file_type(object_code(_)) = no.
+search_for_file_type(foreign_object(_, _)) = no.
+search_for_file_type(foreign_asm(_)) = no.
+search_for_file_type(factt_object(_)) = no.
target_is_grade_or_arch_dependent(Target) :-
target_is_grade_or_arch_dependent(Target, yes).
@@ -696,6 +739,9 @@
target_is_grade_or_arch_dependent(java_code, yes).
target_is_grade_or_arch_dependent(asm_code(_), yes).
target_is_grade_or_arch_dependent(object_code(_), yes).
+target_is_grade_or_arch_dependent(foreign_object(_, _), yes).
+target_is_grade_or_arch_dependent(foreign_asm(_), yes).
+target_is_grade_or_arch_dependent(factt_object(_), yes).
%-----------------------------------------------------------------------------%
@@ -729,7 +775,17 @@
write_dependency_file(target(TargetFile)) --> write_target_file(TargetFile).
write_dependency_file(file(FileName, _)) --> io__write_string(FileName).
-write_target_file(ModuleName - FileType) -->
+write_target_file(ModuleName0 - FileType) -->
+ {
+ ( FileType = foreign_asm(Lang)
+ ; FileType = foreign_object(_, Lang)
+ ),
+ ForeignName = foreign_language_module_name(ModuleName0, Lang)
+ ->
+ ModuleName = ForeignName
+ ;
+ ModuleName = ModuleName0
+ },
prog_out__write_sym_name(ModuleName),
globals__io_get_globals(Globals),
io__write_string(target_extension(Globals, FileType)).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.255
diff -u -r1.255 modules.m
--- compiler/modules.m 10 Dec 2002 07:38:09 -0000 1.255
+++ compiler/modules.m 18 Dec 2002 14:04:42 -0000
@@ -152,6 +152,14 @@
:- pred module_name_to_make_var_name(module_name, string).
:- mode module_name_to_make_var_name(in, out) is det.
+ % Generate the list of .NET DLLs which could be referred to by this
+ % module (including the module itself).
+ % If we are compiling a module within the standard library we should
+ % reference the runtime DLLs and all other library DLLs. If we are
+ % outside the library we should just reference mercury.dll (which will
+ % contain all the DLLs).
+:- func referenced_dlls(module_name, list(module_name)) = list(module_name).
+
%-----------------------------------------------------------------------------%
% read_mod(ModuleName, Extension, Descr, Search, ReturnTimestamp,
@@ -899,6 +907,7 @@
; Ext = ".exe"
; Ext = ".split"
; Ext = ".split.exe"
+ ; Ext = ".dll"
% library files
; Ext = ".a"
; Ext = ".$A"
@@ -4907,15 +4916,6 @@
io__write_string(DepStream, " \\\n\t"),
io__write_string(DepStream, FileName),
write_dependencies_list(Modules, Suffix, DepStream).
-
- % Generate the list of .NET DLLs which could be referred to by this
- % module (including the module itself).
- % If we are compiling a module within the standard library we should
- % reference the runtime DLLs and all other library DLLs. If we are
- % outside the library we should just reference mercury.dll (which will
- % contain all the DLLs).
-
-:- func referenced_dlls(module_name, list(module_name)) = list(module_name).
referenced_dlls(Module, DepModules0) = Modules :-
DepModules = [Module | DepModules0],
Index: tests/hard_coded/foreign_proc_make.exp
===================================================================
RCS file: tests/hard_coded/foreign_proc_make.exp
diff -N tests/hard_coded/foreign_proc_make.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_proc_make.exp 18 Dec 2002 14:04:49 -0000
@@ -0,0 +1 @@
+10
Index: tests/hard_coded/foreign_proc_make.m
===================================================================
RCS file: tests/hard_coded/foreign_proc_make.m
diff -N tests/hard_coded/foreign_proc_make.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_proc_make.m 18 Dec 2002 14:04:49 -0000
@@ -0,0 +1,23 @@
+% Ensure that foreign_proc_make.dll and foreign_proc_make2.dll are built
+% before attempting to build foreign_proc_make__cpp_code.dll and
+% foreign_proc_make2__csharp_code.dll.
+:- module foreign_proc_make.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int, foreign_proc_make2.
+
+main -->
+ io__write_int(f2 + f3),
+ io__nl.
+
+
+:- func f2 = int.
+:- pragma foreign_proc("MC++", f2 = (X::out), [promise_pure], "X=5;").
+f2 = 5.
Index: tests/hard_coded/foreign_proc_make2.m
===================================================================
RCS file: tests/hard_coded/foreign_proc_make2.m
diff -N tests/hard_coded/foreign_proc_make2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_proc_make2.m 18 Dec 2002 14:04:49 -0000
@@ -0,0 +1,11 @@
+% See foreign_proc_make.m
+:- module foreign_proc_make2.
+
+:- interface.
+
+:- func f3 = int.
+
+:- implementation.
+
+:- pragma foreign_proc("C#", f3 = (X::out), [promise_pure], "X=5;").
+f3 = 5.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list