mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 22:35:41 +00:00
17d5aa732e
Estimated hours taken: 20
Branches: main
Add support for interfacing Mercury with the MPS garbage collector.
This change is broken into three parts:
1. Import version 1.100.1 of the MPS kit into the Mercury
CVS repository, in the directory `mps_gc'.
2. Make some changes to the MPS kit for Mercury,
to support fully-conservative collection and tagged pointers,
and to wrap it in an interface that is similar to that of
the Boehm collector.
3. Modify the rest of the Mercury implementation
to support linking with the MPS kit instead
of the Boehm collector. This involved defining
`mps' as a new GC method and a new grade component.
This is part 3 of 3.
Mmake.workspace:
Include the MPS directories in the header file and library search
paths.
tools/bootcheck:
Link the mps_gc directory into the stage2 and stage3 directories.
Mmake.workspace:
runtime/Mmakefile:
scripts/ml.in:
For *.mps grades, link in mps.a.
(XXX ml.in is linking in libmps.a, which is wrong.)
runtime/Mmakefile:
trace/Mmakefile:
In the rule for `check_headers', which checks macro namespace
cleanliness, allow names to start with `MPS_' or `mps_'.
runtime/RESERVED_MACRO_NAMES:
Add `mercury_mps_h', which is used by mps_gc/code/mercury_mps.h
for its header guard. (Normally it would be better to use
uppercase for header guard macro names, but that would be
inconsistent with the coding style used in mps_gc/code.)
scripts/canonical_grade.sh-subr:
scripts/init_grade_options.sh-subr:
scripts/parse_grade_options.sh-subr:
scripts/canonical_grade.sh-subr:
Handle the new `mps' GC method and grade component.
compiler/globals.m:
compiler/options.m:
doc/user_guide.texi:
Replace gc_method `conservative' with two alternatives
`boehm' and `mps'. ("--gc conservative" is still allowed,
and treated as equivalent to "--gc boehm".)
Add new function `gc_is_conservative' to globals.m.
compiler/mercury_compile.m:
compiler/handle_options.m:
Use `gc_is_conservative' rather than `= conservative'.
compiler/handle_options.m:
Handle the "mps" grade component.
(XXX need to document this in options.m and user_guide.texi)
compiler/compile_target_code.m:
Pass the appropriate C defines for the new GC methods.
compiler/mercury_compile.m:
Wrap the work-around for a Boehm GC bug inside `#ifndef MR_MPS_GC'.
library/array.m:
Use GC_FREE() rather than GC_free().
This is needed for two reasons:
- so that it works with MPS, which only defines GC_FREE
- so that it works with then Boehm collector when
GC debugging is enabled
library/benchmarking.m:
Output GC statistics for the MPS collector.
runtime/mercury.h:
runtime/mercury_heap.h:
runtime/mercury_init.h:
runtime/mercury_memory.h:
If MR_MPS_GC is defined, use mercury_mps.h rather than gc.h.
runtime/mercury_conf_param.h:
Add configuration macros MR_BOEHM_GC and MR_MPS_GC.
Set MR_CONSERVATIVE_GC if either of these is set.
Default to MR_BOEHM_GC if only MR_CONSERVATIVE_GC is set.
runtime/mercury_context.h:
runtime/mercury_deep_copy.h:
runtime/mercury_engine.h:
runtime/mercury_float.h:
runtime/mercury_heap.h:
Explictly #include "mercury_conf.h", so that
MR_CONSERVATIVE_GC will be set properly before it is tested.
runtime/mercury_grade.h:
Handle the .mps grade component.
runtime/mercury_memory.c:
runtime/mercury_wrapper.c:
runtime/mercury_memory_handlers.c:
Move the call to MR_setup_signals() earlier in the
initialization sequence, so that the MPS signal handlers
get installed after our signal handlers. This is needed
because our signal handlers assume that any signals that
they can't handle are fatal errors, which interfere's
with MPS's use of signal handlers for memory barriers.
runtime/mercury_wrapper.c:
Add code to initialize the MPS collector.
Put code which is specific to the Boehm collector inside
#ifdef MR_BOEHM_GC rather than #ifdef MR_CONSERVATIVE_GC.
runtime/mercury_wrapper.h:
Update a comment.
1197 lines
39 KiB
Mathematica
1197 lines
39 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2002 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: compile_target_code.m
|
|
% Main authors: fjh, stayl
|
|
%
|
|
% Code to compile the generated `.c', `.s', `.o', etc, files.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
:- module backend_libs__compile_target_code.
|
|
|
|
:- interface.
|
|
|
|
:- import_module parse_tree__prog_data, parse_tree__prog_io.
|
|
:- import_module parse_tree__modules.
|
|
|
|
:- import_module bool, list, io, std_util.
|
|
|
|
|
|
% Are we generating position independent code (for use in a
|
|
% shared library)? On some architectures, pic and non-pic
|
|
% code is incompatible, so we need to generate `.o' and `.pic_o'
|
|
% files.
|
|
:- type pic
|
|
---> pic
|
|
; non_pic
|
|
.
|
|
|
|
% compile_c_file(ErrorStream, PIC, CFile, ObjFile, Succeeded).
|
|
:- pred compile_c_file(io__output_stream, pic, string, string, bool,
|
|
io__state, io__state).
|
|
:- mode compile_c_file(in, in, in, in, out, di, uo) is det.
|
|
|
|
% compile_c_file(ErrorStream, PIC, ModuleName, Succeeded).
|
|
:- pred compile_c_file(io__output_stream, pic, module_name, bool,
|
|
io__state, io__state).
|
|
:- mode compile_c_file(in, in, in, out, di, uo) is det.
|
|
|
|
% assemble(ErrorStream, PIC, ModuleName, Succeeded).
|
|
:- pred assemble(io__output_stream, pic, module_name,
|
|
bool, io__state, io__state).
|
|
:- mode assemble(in, in, in, out, di, uo) is det.
|
|
|
|
% compile_java_file(ErrorStream, ModuleName, Succeeded).
|
|
:- pred compile_java_file(io__output_stream, module_name, bool,
|
|
io__state, io__state).
|
|
:- mode compile_java_file(in, in, out, di, uo) is det.
|
|
|
|
% il_assemble(ErrorStream, ModuleName, HasMain, Succeeded).
|
|
:- pred il_assemble(io__output_stream, module_name,
|
|
has_main, bool, io__state, io__state).
|
|
:- mode il_assemble(in, in, in, out, di, uo) is det.
|
|
|
|
% il_assemble(ErrorStream, ILFile, DLLFile, HasMain, Succeeded).
|
|
:- pred il_assemble(io__output_stream, file_name, file_name,
|
|
has_main, bool, io__state, io__state).
|
|
:- mode il_assemble(in, in, in, in, out, di, uo) is det.
|
|
|
|
% compile_managed_cplusplus_file(ErrorStream,
|
|
% MCPPFile, DLLFile, Succeeded).
|
|
:- pred compile_managed_cplusplus_file(io__output_stream,
|
|
file_name, file_name, bool, io__state, io__state).
|
|
:- 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.
|
|
|
|
% make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded).
|
|
%
|
|
% Make the `.init' file for a library containing the given modules.
|
|
:- pred make_init_file(io__output_stream, module_name,
|
|
list(module_name), bool, io__state, io__state).
|
|
:- mode make_init_file(in, in, in, out, di, uo) is det.
|
|
|
|
% make_init_obj_file(ErrorStream, MainModuleName,
|
|
% AllModuleNames, MaybeInitObjFileName).
|
|
:- pred make_init_obj_file(io__output_stream, module_name, list(module_name),
|
|
maybe(file_name), io__state, io__state).
|
|
:- mode make_init_obj_file(in, in, in, out, di, uo) is det.
|
|
|
|
:- type linked_target_type
|
|
---> executable
|
|
; static_library
|
|
; shared_library
|
|
.
|
|
|
|
% link(TargetType, MainModuleName, ObjectFileNames, Succeeded).
|
|
:- pred link(io__output_stream, linked_target_type, module_name,
|
|
list(string), bool, io__state, io__state).
|
|
:- mode link(in, in, in, in, out, di, uo) is det.
|
|
|
|
% link_module_list(ModulesToLink, Succeeded).
|
|
%
|
|
% The elements of ModulesToLink are the output of
|
|
% `module_name_to_filename(ModuleName, "", no, ModuleToLink)'
|
|
% for each module in the program.
|
|
:- pred link_module_list(list(string), bool, io__state, io__state).
|
|
:- mode link_module_list(in, out, di, uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
% Code to deal with `--split-c-files'.
|
|
|
|
% split_c_to_obj(ErrorStream, ModuleName, NumChunks, Succeeded).
|
|
% Compile the `.c' files produced for a module with `--split-c-files'.
|
|
:- pred split_c_to_obj(io__output_stream, module_name,
|
|
int, bool, io__state, io__state).
|
|
:- mode split_c_to_obj(in, in, in, out, di, uo) is det.
|
|
|
|
% Write the number of `.c' files written by this
|
|
% compilation with `--split-c-files'.
|
|
:- pred write_num_split_c_files(module_name, int, bool, io__state, io__state).
|
|
:- mode write_num_split_c_files(in, in, out, di, uo) is det.
|
|
|
|
% Find the number of `.c' files written by a previous
|
|
% compilation with `--split-c-files'.
|
|
:- pred read_num_split_c_files(module_name, maybe_error(int),
|
|
io__state, io__state).
|
|
:- mode read_num_split_c_files(in, out, di, uo) is det.
|
|
|
|
% remove_split_c_output_files(ModuleName, NumChunks).
|
|
%
|
|
% Remove the `.c' and `.o' files written by a previous
|
|
% compilation with `--split-c-files'.
|
|
:- pred remove_split_c_output_files(module_name, int, io__state, io__state).
|
|
:- mode remove_split_c_output_files(in, in, di, uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% substitute_user_command(Command0, ModuleName,
|
|
% AllModuleNames) = Command
|
|
%
|
|
% Replace all occurrences of `@' in Command with ModuleName,
|
|
% and replace occurrences of `%' in Command with AllModuleNames.
|
|
% This is used to implement the `--pre-link-command' and
|
|
% `--make-init-file-command' options.
|
|
:- func substitute_user_command(string, module_name,
|
|
list(module_name)) = string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- implementation.
|
|
|
|
:- import_module libs__globals, libs__options, libs__handle_options.
|
|
:- import_module hlds__passes_aux, libs__trace_params.
|
|
:- import_module parse_tree__prog_out.
|
|
|
|
:- import_module ll_backend__llds_out. % for llds_out__make_init_name and
|
|
% llds_out__make_rl_data_name
|
|
|
|
:- import_module char, dir, int, require, string.
|
|
|
|
il_assemble(ErrorStream, ModuleName,
|
|
HasMain, Succeeded) -->
|
|
module_name_to_file_name(ModuleName, ".il", no, IL_File),
|
|
( { HasMain = has_main } ->
|
|
module_name_to_file_name(ModuleName, ".exe", yes, TargetFile)
|
|
;
|
|
module_name_to_file_name(ModuleName, ".dll", yes, TargetFile)
|
|
),
|
|
il_assemble(ErrorStream, IL_File, TargetFile,
|
|
HasMain, Succeeded).
|
|
|
|
il_assemble(ErrorStream, IL_File, TargetFile,
|
|
HasMain, Succeeded) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
globals__io_lookup_bool_option(sign_assembly, SignAssembly),
|
|
maybe_write_string(Verbose, "% Assembling `"),
|
|
maybe_write_string(Verbose, IL_File),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
globals__io_lookup_string_option(il_assembler, ILASM),
|
|
globals__io_lookup_accumulating_option(ilasm_flags, ILASMFlagsList),
|
|
{ join_string_list(ILASMFlagsList, "", "", " ", ILASMFlags) },
|
|
{ SignAssembly = yes ->
|
|
SignOpt = "/keyf=mercury.sn "
|
|
;
|
|
SignOpt = ""
|
|
},
|
|
{ Verbose = yes ->
|
|
VerboseOpt = ""
|
|
;
|
|
VerboseOpt = "/quiet "
|
|
},
|
|
globals__io_lookup_bool_option(target_debug, Debug),
|
|
{ Debug = yes ->
|
|
DebugOpt = "/debug "
|
|
;
|
|
DebugOpt = ""
|
|
},
|
|
{ HasMain = has_main ->
|
|
TargetOpt = ""
|
|
;
|
|
TargetOpt = "/dll "
|
|
},
|
|
{ string__append_list([ILASM, " ", SignOpt, VerboseOpt, DebugOpt,
|
|
TargetOpt, ILASMFlags, " /out=", TargetFile,
|
|
" ", IL_File], Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
compile_managed_cplusplus_file(ErrorStream,
|
|
MCPPFileName, DLLFileName, Succeeded) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Compiling `"),
|
|
maybe_write_string(Verbose, MCPPFileName),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
globals__io_lookup_string_option(mcpp_compiler, MCPP),
|
|
globals__io_lookup_accumulating_option(mcpp_flags, MCPPFlagsList),
|
|
{ join_string_list(MCPPFlagsList, "", "", " ", MCPPFlags) },
|
|
globals__io_lookup_bool_option(target_debug, Debug),
|
|
{ Debug = yes ->
|
|
DebugOpt = "" % XXX
|
|
;
|
|
DebugOpt = ""
|
|
},
|
|
|
|
% XXX Should we introduce a `--mcpp-include-directory' option?
|
|
globals__io_lookup_accumulating_option(c_include_directory,
|
|
C_Incl_Dirs),
|
|
{ InclOpts = string__append_list(list__condense(list__map(
|
|
(func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))) },
|
|
|
|
% 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))) },
|
|
|
|
{ string__append_list([MCPP, " -CLR ", DebugOpt, InclOpts,
|
|
DLLDirOpts, MCPPFlags, " ", MCPPFileName,
|
|
"-link -noentry mscoree.lib -dll -out:", DLLFileName],
|
|
Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
compile_csharp_file(ErrorStream,
|
|
CSharpFileName, DLLFileName, Succeeded) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Compiling `"),
|
|
maybe_write_string(Verbose, CSharpFileName),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
globals__io_lookup_string_option(csharp_compiler, CSC),
|
|
globals__io_lookup_accumulating_option(csharp_flags, CSCFlagsList),
|
|
{ join_string_list(CSCFlagsList, "", "", " ", CSCFlags) },
|
|
globals__io_lookup_bool_option(target_debug, Debug),
|
|
{ Debug = yes ->
|
|
DebugOpt = "" % XXX
|
|
;
|
|
DebugOpt = ""
|
|
},
|
|
|
|
% 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))) },
|
|
|
|
{ string__append_list([CSC, " -CLR ", DebugOpt,
|
|
" /t:library ", DLLDirOpts, CSCFlags, " ",
|
|
" /out:", DLLFileName, CSharpFileName], Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
split_c_to_obj(ErrorStream, ModuleName, NumChunks, Succeeded) -->
|
|
split_c_to_obj(ErrorStream, ModuleName, 0, NumChunks, Succeeded).
|
|
|
|
% compile each of the C files in `<module>.dir'
|
|
:- pred split_c_to_obj(io__output_stream, module_name,
|
|
int, int, bool, io__state, io__state).
|
|
:- mode split_c_to_obj(in, in, in, in, out, di, uo) is det.
|
|
|
|
split_c_to_obj(ErrorStream, ModuleName,
|
|
Chunk, NumChunks, Succeeded) -->
|
|
( { Chunk > NumChunks } ->
|
|
{ Succeeded = yes }
|
|
;
|
|
globals__io_lookup_string_option(object_file_extension, Obj),
|
|
module_name_to_split_c_file_name(ModuleName, Chunk,
|
|
".c", C_File),
|
|
module_name_to_split_c_file_name(ModuleName, Chunk,
|
|
Obj, O_File),
|
|
compile_c_file(ErrorStream, non_pic,
|
|
C_File, O_File, Succeeded0),
|
|
( { Succeeded0 = no } ->
|
|
{ Succeeded = no }
|
|
;
|
|
{ Chunk1 is Chunk + 1 },
|
|
split_c_to_obj(ErrorStream,
|
|
ModuleName, Chunk1, NumChunks, Succeeded)
|
|
)
|
|
).
|
|
|
|
% WARNING: The code here duplicates the functionality of scripts/mgnuc.in.
|
|
% Any changes there may also require changes here, and vice versa.
|
|
|
|
:- type compiler_type ---> gcc ; lcc ; unknown.
|
|
|
|
compile_c_file(ErrorStream, PIC, ModuleName, Succeeded) -->
|
|
module_name_to_file_name(ModuleName, ".c", yes, C_File),
|
|
(
|
|
{ PIC = pic },
|
|
globals__io_lookup_string_option(pic_object_file_extension,
|
|
ObjExt)
|
|
;
|
|
{ PIC = non_pic },
|
|
globals__io_lookup_string_option(object_file_extension, ObjExt)
|
|
),
|
|
module_name_to_file_name(ModuleName, ObjExt, yes, O_File),
|
|
compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded).
|
|
|
|
compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
globals__io_lookup_string_option(c_flag_to_name_object_file,
|
|
NameObjectFile),
|
|
maybe_write_string(Verbose, "% Compiling `"),
|
|
maybe_write_string(Verbose, C_File),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
globals__io_lookup_string_option(cc, CC),
|
|
globals__io_lookup_accumulating_option(cflags, C_Flags_List),
|
|
{ join_string_list(C_Flags_List, "", "", " ", CFLAGS) },
|
|
|
|
(
|
|
{ PIC = pic },
|
|
globals__io_lookup_string_option(cflags_for_pic,
|
|
CFLAGS_FOR_PIC)
|
|
;
|
|
{ PIC = non_pic },
|
|
{ CFLAGS_FOR_PIC = "" }
|
|
),
|
|
|
|
globals__io_lookup_bool_option(use_subdirs, UseSubdirs),
|
|
globals__io_lookup_bool_option(split_c_files, SplitCFiles),
|
|
{ (UseSubdirs = yes ; SplitCFiles = yes) ->
|
|
% the source file (foo.c) will be compiled in a subdirectory
|
|
% (either Mercury/cs, foo.dir, or Mercury/dirs/foo.dir,
|
|
% depending on which of these two options is set)
|
|
% so we need to add `-I.' so it can
|
|
% include header files in the source directory.
|
|
SubDirInclOpt = "-I. "
|
|
;
|
|
SubDirInclOpt = ""
|
|
},
|
|
globals__io_lookup_accumulating_option(c_include_directory,
|
|
C_Incl_Dirs),
|
|
{ InclOpt = string__append_list(list__condense(list__map(
|
|
(func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))) },
|
|
globals__io_lookup_bool_option(split_c_files, Split_C_Files),
|
|
{ Split_C_Files = yes ->
|
|
SplitOpt = "-DMR_SPLIT_C_FILES "
|
|
;
|
|
SplitOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
|
|
( { HighLevelCode = yes } ->
|
|
{ HighLevelCodeOpt = "-DMR_HIGHLEVEL_CODE " }
|
|
;
|
|
{ HighLevelCodeOpt = "" }
|
|
),
|
|
globals__io_lookup_bool_option(gcc_nested_functions,
|
|
GCC_NestedFunctions),
|
|
( { GCC_NestedFunctions = yes } ->
|
|
{ NestedFunctionsOpt = "-DMR_USE_GCC_NESTED_FUNCTIONS " }
|
|
;
|
|
{ NestedFunctionsOpt = "" }
|
|
),
|
|
globals__io_lookup_bool_option(highlevel_data, HighLevelData),
|
|
( { HighLevelData = yes } ->
|
|
{ HighLevelDataOpt = "-DMR_HIGHLEVEL_DATA " }
|
|
;
|
|
{ HighLevelDataOpt = "" }
|
|
),
|
|
globals__io_lookup_bool_option(gcc_global_registers, GCC_Regs),
|
|
( { GCC_Regs = yes } ->
|
|
globals__io_lookup_string_option(cflags_for_regs,
|
|
CFLAGS_FOR_REGS),
|
|
{ RegOpt = "-DMR_USE_GCC_GLOBAL_REGISTERS " }
|
|
;
|
|
{ CFLAGS_FOR_REGS = "" },
|
|
{ RegOpt = "" }
|
|
),
|
|
globals__io_lookup_bool_option(gcc_non_local_gotos, GCC_Gotos),
|
|
( { GCC_Gotos = yes } ->
|
|
{ GotoOpt = "-DMR_USE_GCC_NONLOCAL_GOTOS " },
|
|
globals__io_lookup_string_option(cflags_for_gotos,
|
|
CFLAGS_FOR_GOTOS)
|
|
;
|
|
{ GotoOpt = "" },
|
|
{ CFLAGS_FOR_GOTOS = "" }
|
|
),
|
|
globals__io_lookup_bool_option(asm_labels, ASM_Labels),
|
|
{ ASM_Labels = yes ->
|
|
AsmOpt = "-DMR_USE_ASM_LABELS "
|
|
;
|
|
AsmOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(parallel, Parallel),
|
|
( { Parallel = yes } ->
|
|
globals__io_lookup_string_option(cflags_for_threads,
|
|
CFLAGS_FOR_THREADS)
|
|
;
|
|
{ CFLAGS_FOR_THREADS = "" }
|
|
),
|
|
globals__io_get_gc_method(GC_Method),
|
|
{
|
|
GC_Method = boehm,
|
|
GC_Opt = "-DMR_CONSERVATIVE_GC -DMR_BOEHM_GC "
|
|
;
|
|
GC_Method = mps,
|
|
GC_Opt = "-DMR_CONSERVATIVE_GC -DMR_MPS_GC "
|
|
;
|
|
GC_Method = accurate,
|
|
GC_Opt = "-DMR_NATIVE_GC "
|
|
;
|
|
GC_Method = none,
|
|
GC_Opt = ""
|
|
},
|
|
globals__io_lookup_bool_option(profile_calls, ProfileCalls),
|
|
{ ProfileCalls = yes ->
|
|
ProfileCallsOpt = "-DMR_MPROF_PROFILE_CALLS "
|
|
;
|
|
ProfileCallsOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(profile_time, ProfileTime),
|
|
{ ProfileTime = yes ->
|
|
ProfileTimeOpt = "-DMR_MPROF_PROFILE_TIME "
|
|
;
|
|
ProfileTimeOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(profile_memory, ProfileMemory),
|
|
{ ProfileMemory = yes ->
|
|
ProfileMemoryOpt = "-DMR_MPROF_PROFILE_MEMORY "
|
|
;
|
|
ProfileMemoryOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(profile_deep, ProfileDeep),
|
|
{ ProfileDeep = yes ->
|
|
ProfileDeepOpt = "-DMR_DEEP_PROFILING "
|
|
;
|
|
ProfileDeepOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(pic_reg, PIC_Reg),
|
|
{ PIC_Reg = yes ->
|
|
PIC_Reg_Opt = "-DMR_PIC_REG "
|
|
;
|
|
PIC_Reg_Opt = ""
|
|
},
|
|
globals__io_get_tags_method(Tags_Method),
|
|
{ Tags_Method = high ->
|
|
TagsOpt = "-DMR_HIGHTAGS "
|
|
;
|
|
TagsOpt = ""
|
|
},
|
|
globals__io_lookup_int_option(num_tag_bits, NumTagBits),
|
|
{ string__int_to_string(NumTagBits, NumTagBitsString) },
|
|
{ string__append_list(
|
|
["-DMR_TAGBITS=", NumTagBitsString, " "], NumTagBitsOpt) },
|
|
globals__io_lookup_bool_option(require_tracing, RequireTracing),
|
|
{ RequireTracing = yes ->
|
|
RequireTracingOpt = "-DMR_REQUIRE_TRACING "
|
|
;
|
|
RequireTracingOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(stack_trace, StackTrace),
|
|
{ StackTrace = yes ->
|
|
StackTraceOpt = "-DMR_STACK_TRACE "
|
|
;
|
|
StackTraceOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(target_debug, Target_Debug),
|
|
{ Target_Debug = yes ->
|
|
Target_DebugOpt = "-g "
|
|
;
|
|
Target_DebugOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(low_level_debug, LL_Debug),
|
|
{ LL_Debug = yes ->
|
|
LL_DebugOpt = "-DMR_LOW_LEVEL_DEBUG "
|
|
;
|
|
LL_DebugOpt = ""
|
|
},
|
|
{ string__sub_string_search(CC, "gcc", _) ->
|
|
CompilerType = gcc
|
|
; string__sub_string_search(CC, "lcc", _) ->
|
|
CompilerType = lcc
|
|
;
|
|
CompilerType = unknown
|
|
},
|
|
globals__io_lookup_bool_option(use_trail, UseTrail),
|
|
{ UseTrail = yes ->
|
|
UseTrailOpt = "-DMR_USE_TRAIL "
|
|
;
|
|
UseTrailOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(reserve_tag, ReserveTag),
|
|
{ ReserveTag = yes ->
|
|
ReserveTagOpt = "-DMR_RESERVE_TAG "
|
|
;
|
|
ReserveTagOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(use_minimal_model, MinimalModel),
|
|
{ MinimalModel = yes ->
|
|
MinimalModelOpt = "-DMR_USE_MINIMAL_MODEL "
|
|
;
|
|
MinimalModelOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(type_layout, TypeLayoutOption),
|
|
{ TypeLayoutOption = no ->
|
|
TypeLayoutOpt = "-DMR_NO_TYPE_LAYOUT "
|
|
;
|
|
TypeLayoutOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(c_optimize, C_optimize),
|
|
{ C_optimize = yes ->
|
|
( CompilerType = gcc ->
|
|
OptimizeOpt = "-O2 -fomit-frame-pointer "
|
|
; CompilerType = lcc ->
|
|
OptimizeOpt = ""
|
|
;
|
|
OptimizeOpt = "-O "
|
|
)
|
|
;
|
|
OptimizeOpt = ""
|
|
},
|
|
globals__io_lookup_bool_option(inline_alloc, InlineAlloc),
|
|
{ InlineAlloc = yes ->
|
|
InlineAllocOpt = "-DMR_INLINE_ALLOC -DSILENT "
|
|
;
|
|
InlineAllocOpt = ""
|
|
},
|
|
{ CompilerType = gcc ->
|
|
% We don't enable `-Wpointer-arith', because it causes
|
|
% too many complaints in system header files.
|
|
% This is fixed in gcc 3.0, though, so at some
|
|
% point we should re-enable this.
|
|
%
|
|
% If --inline-alloc is enabled, don't enable missing-prototype
|
|
% warnings, since gc_inline.h is missing lots of prototypes.
|
|
%
|
|
% For a full list of the other gcc warnings that we don't
|
|
% enable, and why, see scripts/mgnuc.in.
|
|
( InlineAlloc = yes ->
|
|
WarningOpt = "-Wall -Wwrite-strings -Wshadow -Wmissing-prototypes -Wno-unused -Wno-uninitialized "
|
|
;
|
|
WarningOpt = "-Wall -Wwrite-strings -Wshadow -Wmissing-prototypes -Wno-unused -Wno-uninitialized -Wstrict-prototypes "
|
|
)
|
|
; CompilerType = lcc ->
|
|
WarningOpt = "-w "
|
|
;
|
|
WarningOpt = ""
|
|
},
|
|
% Be careful with the order here! Some options override others,
|
|
% e.g. CFLAGS_FOR_REGS must come after OptimizeOpt so that
|
|
% it can override -fomit-frame-pointer with -fno-omit-frame-pointer.
|
|
% Also be careful that each option is separated by spaces.
|
|
{ string__append_list([CC, " ", SubDirInclOpt, InclOpt,
|
|
SplitOpt, OptimizeOpt,
|
|
HighLevelCodeOpt, NestedFunctionsOpt, HighLevelDataOpt,
|
|
RegOpt, GotoOpt, AsmOpt,
|
|
CFLAGS_FOR_REGS, " ", CFLAGS_FOR_GOTOS, " ",
|
|
CFLAGS_FOR_THREADS, " ", CFLAGS_FOR_PIC, " ",
|
|
GC_Opt, ProfileCallsOpt, ProfileTimeOpt, ProfileMemoryOpt,
|
|
ProfileDeepOpt, PIC_Reg_Opt, TagsOpt, NumTagBitsOpt,
|
|
Target_DebugOpt, LL_DebugOpt,
|
|
StackTraceOpt, RequireTracingOpt,
|
|
UseTrailOpt, ReserveTagOpt, MinimalModelOpt, TypeLayoutOpt,
|
|
InlineAllocOpt, WarningOpt, CFLAGS,
|
|
" -c ", C_File, " ", NameObjectFile, O_File], Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
compile_java_file(ErrorStream, ModuleName, Succeeded) -->
|
|
module_name_to_file_name(ModuleName, ".java", no, JavaFile),
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Compiling `"),
|
|
maybe_write_string(Verbose, JavaFile),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
globals__io_lookup_string_option(java_compiler, JavaCompiler),
|
|
globals__io_lookup_accumulating_option(java_flags, JavaFlagsList),
|
|
{ join_string_list(JavaFlagsList, "", "", " ", JAVAFLAGS) },
|
|
|
|
globals__io_lookup_accumulating_option(java_classpath,
|
|
Java_Incl_Dirs),
|
|
( { Java_Incl_Dirs = [] } ->
|
|
{ InclOpt = "" }
|
|
;
|
|
% XXX PathSeparator should be ";" on Windows
|
|
{ PathSeparator = ":" },
|
|
{ join_string_list(Java_Incl_Dirs, "", "",
|
|
PathSeparator, ClassPath) },
|
|
{ InclOpt = string__append_list([
|
|
"-classpath ", quote_arg(ClassPath), " "]) }
|
|
),
|
|
globals__io_lookup_bool_option(target_debug, Target_Debug),
|
|
{ Target_Debug = yes ->
|
|
Target_DebugOpt = "-g "
|
|
;
|
|
Target_DebugOpt = ""
|
|
},
|
|
% Be careful with the order here! Some options may override others.
|
|
% Also be careful that each option is separated by spaces.
|
|
{ string__append_list([JavaCompiler, " ", InclOpt,
|
|
Target_DebugOpt, JAVAFLAGS, JavaFile], Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
assemble(ErrorStream, PIC, ModuleName, Succeeded) -->
|
|
globals__io_lookup_bool_option(pic, Pic),
|
|
{ ( Pic = yes ; PIC = pic ) ->
|
|
AsmExt = ".pic_s",
|
|
GCCFLAGS_FOR_PIC = ""
|
|
;
|
|
AsmExt = ".s",
|
|
GCCFLAGS_FOR_PIC = "-fpic"
|
|
},
|
|
module_name_to_file_name(ModuleName, AsmExt, no, AsmFile),
|
|
globals__io_lookup_string_option(object_file_extension, Obj),
|
|
module_name_to_file_name(ModuleName, Obj, yes, ObjFile),
|
|
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
maybe_write_string(Verbose, "% Assembling `"),
|
|
maybe_write_string(Verbose, AsmFile),
|
|
maybe_write_string(Verbose, "':\n"),
|
|
% XXX should we use new asm_* options rather than
|
|
% reusing cc, cflags, c_flag_to_name_object_file?
|
|
globals__io_lookup_string_option(cc, CC),
|
|
globals__io_lookup_string_option(c_flag_to_name_object_file,
|
|
NameObjectFile),
|
|
globals__io_lookup_accumulating_option(cflags, C_Flags_List),
|
|
{ join_string_list(C_Flags_List, "", "", " ", CFLAGS) },
|
|
% Be careful with the order here.
|
|
% Also be careful that each option is separated by spaces.
|
|
{ string__append_list([CC, " ", CFLAGS, " ", GCCFLAGS_FOR_PIC,
|
|
" -c ", AsmFile, " ", NameObjectFile, ObjFile], Command) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
Command, Succeeded).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
make_init_file(ErrorStream, MainModuleName, AllModules, Succeeded) -->
|
|
module_name_to_file_name(MainModuleName, ".init.tmp",
|
|
yes, TmpInitFileName),
|
|
io__open_output(TmpInitFileName, InitFileRes),
|
|
(
|
|
{ InitFileRes = ok(InitFileStream) },
|
|
globals__io_lookup_bool_option(aditi, Aditi),
|
|
list__foldl(
|
|
(pred(ModuleName::in, di, uo) is det -->
|
|
{ llds_out__make_init_name(ModuleName,
|
|
InitFuncName0) },
|
|
{ InitFuncName = InitFuncName0 ++ "init" },
|
|
io__write_string(InitFileStream, "INIT "),
|
|
io__write_string(InitFileStream, InitFuncName),
|
|
io__nl(InitFileStream),
|
|
( { Aditi = yes } ->
|
|
{ llds_out__make_rl_data_name(ModuleName,
|
|
RLName) },
|
|
io__write_string(InitFileStream,
|
|
"ADITI_DATA "),
|
|
io__write_string(InitFileStream, RLName),
|
|
io__nl(InitFileStream)
|
|
;
|
|
[]
|
|
)
|
|
), AllModules),
|
|
globals__io_lookup_maybe_string_option(extra_init_command,
|
|
MaybeInitFileCommand),
|
|
(
|
|
{ MaybeInitFileCommand = yes(InitFileCommand0) },
|
|
{ InitFileCommand = substitute_user_command(
|
|
InitFileCommand0, MainModuleName,
|
|
AllModules) },
|
|
invoke_shell_command(InitFileStream, verbose_commands,
|
|
InitFileCommand, Succeeded0)
|
|
;
|
|
{ MaybeInitFileCommand = no },
|
|
{ Succeeded0 = yes }
|
|
),
|
|
|
|
io__close_output(InitFileStream),
|
|
module_name_to_file_name(MainModuleName, ".init",
|
|
yes, InitFileName),
|
|
update_interface(InitFileName, Succeeded1),
|
|
{ Succeeded = Succeeded0 `and` Succeeded1 }
|
|
;
|
|
{ InitFileRes = error(Error) },
|
|
io__progname_base("mercury_compile", ProgName),
|
|
io__write_string(ErrorStream, ProgName),
|
|
io__write_string(ErrorStream, ": can't open `"),
|
|
io__write_string(ErrorStream, TmpInitFileName),
|
|
io__write_string(ErrorStream, "' for output:\n"),
|
|
io__nl(ErrorStream),
|
|
io__write_string(ErrorStream, io__error_message(Error)),
|
|
io__nl(ErrorStream),
|
|
{ Succeeded = no }
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
link_module_list(Modules, Succeeded) -->
|
|
globals__io_lookup_string_option(output_file_name, OutputFileName0),
|
|
( { OutputFileName0 = "" } ->
|
|
( { Modules = [Module | _] } ->
|
|
{ OutputFileName = Module }
|
|
;
|
|
{ error("link_module_list: no modules") }
|
|
)
|
|
;
|
|
{ OutputFileName = OutputFileName0 }
|
|
),
|
|
|
|
{ file_name_to_module_name(OutputFileName, MainModuleName) },
|
|
|
|
globals__io_lookup_string_option(object_file_extension, Obj),
|
|
globals__io_get_target(Target),
|
|
globals__io_lookup_bool_option(split_c_files, SplitFiles),
|
|
io__output_stream(OutputStream),
|
|
( { Target = asm } ->
|
|
% for --target asm, we generate everything into a single object file
|
|
( { Modules = [FirstModule | _] } ->
|
|
join_module_list([FirstModule], Obj, [], ObjectsList)
|
|
;
|
|
{ error("link_module_list: no modules") }
|
|
),
|
|
{ MakeLibCmdOK = yes }
|
|
; { SplitFiles = yes } ->
|
|
globals__io_lookup_string_option(library_extension, LibExt),
|
|
module_name_to_file_name(MainModuleName, LibExt,
|
|
yes, SplitLibFileName),
|
|
{ string__append(".dir/*", Obj, DirObj) },
|
|
join_module_list(Modules, DirObj, [], ObjectList),
|
|
create_archive(OutputStream, SplitLibFileName,
|
|
ObjectList, MakeLibCmdOK),
|
|
{ ObjectsList = [SplitLibFileName] }
|
|
;
|
|
{ MakeLibCmdOK = yes },
|
|
join_module_list(Modules, Obj, [], ObjectsList)
|
|
),
|
|
( { MakeLibCmdOK = no } ->
|
|
{ Succeeded = no }
|
|
;
|
|
globals__io_lookup_bool_option(compile_to_shared_lib,
|
|
CompileToSharedLib),
|
|
{ TargetType =
|
|
(CompileToSharedLib = yes -> shared_library ; executable) },
|
|
( { TargetType = executable } ->
|
|
{ list__map(
|
|
(pred(ModuleStr::in, ModuleName::out) is det :-
|
|
dir__basename(ModuleStr, ModuleStrBase),
|
|
file_name_to_module_name(ModuleStrBase, ModuleName)
|
|
),
|
|
Modules, ModuleNames) },
|
|
{ MustCompile = yes },
|
|
make_init_obj_file(OutputStream, MustCompile, MainModuleName,
|
|
ModuleNames, InitObjResult)
|
|
;
|
|
{ InitObjResult = yes("") }
|
|
),
|
|
(
|
|
{ InitObjResult = yes(InitObjFileName) },
|
|
globals__io_lookup_accumulating_option(link_objects,
|
|
ExtraLinkObjectsList),
|
|
{ AllObjects0 = ObjectsList ++ ExtraLinkObjectsList },
|
|
{ AllObjects =
|
|
( InitObjFileName = "" ->
|
|
AllObjects0
|
|
;
|
|
[InitObjFileName | AllObjects0]
|
|
) },
|
|
link(OutputStream, TargetType, MainModuleName,
|
|
AllObjects, Succeeded)
|
|
;
|
|
{ InitObjResult = no },
|
|
{ Succeeded = no }
|
|
)
|
|
).
|
|
|
|
make_init_obj_file(ErrorStream,
|
|
ModuleName, ModuleNames, Result) -->
|
|
{ MustCompile = no },
|
|
make_init_obj_file(ErrorStream,
|
|
MustCompile, ModuleName, ModuleNames, Result).
|
|
|
|
:- pred make_init_obj_file(io__output_stream, bool,
|
|
module_name, list(module_name), maybe(file_name),
|
|
io__state, io__state).
|
|
:- mode make_init_obj_file(in,
|
|
in, in, in, out, di, uo) is det.
|
|
|
|
make_init_obj_file(ErrorStream, MustCompile, ModuleName,
|
|
ModuleNames, Result) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
globals__io_lookup_bool_option(statistics, Stats),
|
|
maybe_write_string(Verbose, "% Creating initialization file...\n"),
|
|
|
|
globals__io_get_trace_level(TraceLevel),
|
|
{ given_trace_level_is_none(TraceLevel) = no ->
|
|
TraceOpt = "--trace "
|
|
;
|
|
TraceOpt = ""
|
|
},
|
|
globals__io_get_globals(Globals),
|
|
{ compute_grade(Globals, Grade) },
|
|
|
|
standard_library_directory_option(StdLibOpt),
|
|
globals__io_lookup_string_option(object_file_extension, Obj),
|
|
{ string__append("_init", Obj, InitObj) },
|
|
module_name_to_file_name(ModuleName, "_init.c", yes, InitCFileName),
|
|
module_name_to_file_name(ModuleName, InitObj, yes, InitObjFileName),
|
|
|
|
list__map_foldl(
|
|
(pred(ThisModuleName::in, CFileName::out, di, uo) is det -->
|
|
module_name_to_file_name(ThisModuleName, ".c", no,
|
|
CFileName)
|
|
), ModuleNames, CFileNameList),
|
|
{ join_string_list(CFileNameList, "", "", " ", CFileNames) },
|
|
|
|
globals__io_lookup_accumulating_option(link_flags, LinkFlagsList),
|
|
{ join_string_list(LinkFlagsList, "", "", " ", LinkFlags) },
|
|
|
|
globals__io_lookup_accumulating_option(init_file_directories,
|
|
InitFileDirsList),
|
|
{ join_quoted_string_list(InitFileDirsList,
|
|
"-I ", "", " ", InitFileDirs) },
|
|
|
|
globals__io_lookup_accumulating_option(init_files, InitFileNamesList),
|
|
{ join_quoted_string_list(InitFileNamesList,
|
|
"", "", " ", InitFileNames) },
|
|
|
|
globals__io_lookup_accumulating_option(trace_init_files,
|
|
TraceInitFileNamesList),
|
|
{ join_quoted_string_list(TraceInitFileNamesList, "--trace-init-file ",
|
|
"", " ", TraceInitFileNames) },
|
|
|
|
{ TmpInitCFileName = InitCFileName ++ ".tmp" },
|
|
{ MkInitCmd = string__append_list(
|
|
["c2init --grade ", Grade, " ", TraceOpt, StdLibOpt, LinkFlags,
|
|
" --init-c-file ", TmpInitCFileName, " ", InitFileDirs, " ",
|
|
TraceInitFileNames, " ", InitFileNames, " ", CFileNames]) },
|
|
invoke_shell_command(ErrorStream, verbose, MkInitCmd, MkInitOK0),
|
|
maybe_report_stats(Stats),
|
|
( { MkInitOK0 = yes } ->
|
|
update_interface(InitCFileName, MkInitOK1),
|
|
(
|
|
{ MkInitOK1 = yes },
|
|
|
|
(
|
|
{ MustCompile = yes },
|
|
{ Compile = yes }
|
|
;
|
|
{ MustCompile = no },
|
|
io__file_modification_time(InitCFileName,
|
|
InitCModTimeResult),
|
|
io__file_modification_time(InitObjFileName,
|
|
InitObjModTimeResult),
|
|
{
|
|
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"),
|
|
|
|
compile_c_file(ErrorStream, non_pic, InitCFileName,
|
|
InitObjFileName, CompileOK),
|
|
maybe_report_stats(Stats),
|
|
( { CompileOK = no } ->
|
|
{ Result = no }
|
|
;
|
|
{ Result = yes(InitObjFileName) }
|
|
)
|
|
;
|
|
{ Compile = no },
|
|
{ Result = yes(InitObjFileName) }
|
|
)
|
|
;
|
|
{ MkInitOK1 = no },
|
|
{ Result = no }
|
|
)
|
|
;
|
|
{ Result = no }
|
|
).
|
|
|
|
link(ErrorStream, LinkTargetType, ModuleName,
|
|
ObjectsList, Succeeded) -->
|
|
globals__io_lookup_bool_option(verbose, Verbose),
|
|
globals__io_lookup_bool_option(statistics, Stats),
|
|
|
|
globals__io_get_trace_level(TraceLevel),
|
|
{ given_trace_level_is_none(TraceLevel) = no ->
|
|
TraceOpt = "--trace "
|
|
;
|
|
TraceOpt = ""
|
|
},
|
|
globals__io_get_globals(Globals),
|
|
{ compute_grade(Globals, Grade) },
|
|
|
|
maybe_write_string(Verbose, "% Linking...\n"),
|
|
( { LinkTargetType = static_library } ->
|
|
globals__io_lookup_string_option(library_extension, LibExt),
|
|
module_name_to_lib_file_name("lib", ModuleName, LibExt,
|
|
yes, LibName),
|
|
create_archive(ErrorStream, LibName, ObjectsList, ArCmdOK),
|
|
maybe_report_stats(Stats),
|
|
( { ArCmdOK = no } ->
|
|
{ Succeeded = no }
|
|
;
|
|
{ Succeeded = yes }
|
|
)
|
|
;
|
|
( { LinkTargetType = shared_library } ->
|
|
{ SharedLibOpt = "--make-shared-lib " },
|
|
{ LDFlagsOpt = ld_libflags },
|
|
globals__io_lookup_string_option(
|
|
shared_library_extension, SharedLibExt),
|
|
module_name_to_lib_file_name("lib", ModuleName,
|
|
SharedLibExt, yes, OutputFileName)
|
|
;
|
|
{ SharedLibOpt = "" },
|
|
{ LDFlagsOpt = ld_flags },
|
|
globals__io_lookup_string_option(
|
|
executable_file_extension, ExeExt),
|
|
module_name_to_file_name(ModuleName, ExeExt,
|
|
yes, OutputFileName)
|
|
),
|
|
globals__io_lookup_bool_option(target_debug, Target_Debug),
|
|
{ Target_Debug = yes ->
|
|
Target_Debug_Opt = "--no-strip "
|
|
;
|
|
Target_Debug_Opt = ""
|
|
},
|
|
standard_library_directory_option(StdLibOpt),
|
|
{ join_string_list(ObjectsList, "", "", " ", Objects) },
|
|
globals__io_lookup_accumulating_option(link_flags,
|
|
LinkFlagsList),
|
|
{ join_string_list(LinkFlagsList, "", "", " ", LinkFlags) },
|
|
globals__io_lookup_accumulating_option(LDFlagsOpt,
|
|
LDFlagsList),
|
|
{ join_string_list(LDFlagsList, "", "", " ", LDFlags) },
|
|
globals__io_lookup_accumulating_option(
|
|
link_library_directories,
|
|
LinkLibraryDirectoriesList),
|
|
{ join_quoted_string_list(LinkLibraryDirectoriesList, "-L", "",
|
|
" ", LinkLibraryDirectories) },
|
|
globals__io_lookup_accumulating_option(link_libraries,
|
|
LinkLibrariesList),
|
|
{ join_quoted_string_list(LinkLibrariesList, "-l", "", " ",
|
|
LinkLibraries) },
|
|
|
|
% Note that LDFlags may contain `-l' options
|
|
% so it should come after Objects.
|
|
{ string__append_list(
|
|
["ml --grade ", Grade, " ", SharedLibOpt,
|
|
Target_Debug_Opt, TraceOpt, StdLibOpt,
|
|
LinkFlags, " ", LinkLibraryDirectories,
|
|
" -- -o ", OutputFileName, " ", Objects, " ",
|
|
LDFlags, " ", LinkLibraries],
|
|
LinkCmd) },
|
|
invoke_shell_command(ErrorStream, verbose_commands,
|
|
LinkCmd, Succeeded),
|
|
maybe_report_stats(Stats)
|
|
).
|
|
|
|
:- pred create_archive(io__output_stream, file_name, list(file_name),
|
|
bool, io__state, io__state).
|
|
:- mode create_archive(in, in, in, out, di, uo) is det.
|
|
|
|
create_archive(ErrorStream, LibFileName, ObjectList, MakeLibCmdOK) -->
|
|
globals__io_lookup_string_option(create_archive_command, ArCmd),
|
|
globals__io_lookup_accumulating_option(
|
|
create_archive_command_flags, ArFlagsList),
|
|
{ join_string_list(ArFlagsList, "", "", " ", ArFlags) },
|
|
globals__io_lookup_string_option(
|
|
create_archive_command_output_flag, ArOutputFlag),
|
|
globals__io_lookup_string_option(ranlib_command, RanLib),
|
|
{ join_string_list(ObjectList, "", "", " ", Objects) },
|
|
{ MakeLibCmd = string__append_list([
|
|
ArCmd, " ", ArFlags, " ", ArOutputFlag, " ",
|
|
LibFileName, " ", Objects,
|
|
" && ", RanLib, " ", LibFileName]) },
|
|
invoke_system_command(ErrorStream, verbose_commands,
|
|
MakeLibCmd, MakeLibCmdOK).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred standard_library_directory_option(string, io__state, io__state).
|
|
:- mode standard_library_directory_option(out, di, uo) is det.
|
|
|
|
standard_library_directory_option(Opt) -->
|
|
globals__io_lookup_maybe_string_option(
|
|
mercury_standard_library_directory, MaybeStdLibDir),
|
|
{
|
|
MaybeStdLibDir = yes(StdLibDir),
|
|
Opt = "--mercury-standard-library-directory "
|
|
++ StdLibDir ++ " "
|
|
;
|
|
MaybeStdLibDir = no,
|
|
Opt = "--no-mercury-standard-library-directory "
|
|
}.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% join_string_list(Strings, Prefix, Suffix, Serarator, Result)
|
|
%
|
|
% Appends the strings in the list `Strings' together into the
|
|
% string Result. Each string is prefixed by Prefix, suffixed by
|
|
% Suffix and separated by Separator.
|
|
|
|
:- pred join_string_list(list(string), string, string, string, string).
|
|
:- mode join_string_list(in, in, in, in, out) is det.
|
|
|
|
join_string_list([], _Prefix, _Suffix, _Separator, "").
|
|
join_string_list([String | Strings], Prefix, Suffix, Separator, Result) :-
|
|
( Strings = [] ->
|
|
string__append_list([Prefix, String, Suffix], Result)
|
|
;
|
|
join_string_list(Strings, Prefix, Suffix, Separator, Result0),
|
|
string__append_list([Prefix, String, Suffix, Separator,
|
|
Result0], Result)
|
|
).
|
|
|
|
% As above, but quote the strings first.
|
|
% Note that the strings in values of the *flags options are
|
|
% already quoted.
|
|
:- pred join_quoted_string_list(list(string), string, string, string, string).
|
|
:- mode join_quoted_string_list(in, in, in, in, out) is det.
|
|
|
|
join_quoted_string_list(Strings, Prefix, Suffix, Separator, Result) :-
|
|
join_string_list(map(quote_arg, Strings),
|
|
Prefix, Suffix, Separator, Result).
|
|
|
|
% join_module_list(ModuleNames, Extension, Terminator, Result)
|
|
%
|
|
% The list of strings `Result' is computed from the list of strings
|
|
% `ModuleNames', by removing any directory paths, and
|
|
% converting the strings to file names and then back,
|
|
% adding the specified Extension. (This conversion ensures
|
|
% that we follow the usual file naming conventions.)
|
|
% Each file name is separated by a space from the next one,
|
|
% and the result is followed by the list of strings `Terminator'.
|
|
|
|
:- pred join_module_list(list(string), string, list(string), list(string),
|
|
io__state, io__state).
|
|
:- mode join_module_list(in, in, in, out, di, uo) is det.
|
|
|
|
join_module_list([], _Extension, Terminator, Terminator) --> [].
|
|
join_module_list([Module | Modules], Extension, Terminator,
|
|
[FileName, " " | Rest]) -->
|
|
{ dir__basename(Module, BaseName) },
|
|
{ file_name_to_module_name(BaseName, ModuleName) },
|
|
module_name_to_file_name(ModuleName, Extension, no, FileName),
|
|
join_module_list(Modules, Extension, Terminator, Rest).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
write_num_split_c_files(ModuleName, NumChunks, Succeeded) -->
|
|
module_name_to_file_name(ModuleName, ".num_split", yes,
|
|
NumChunksFileName),
|
|
io__open_output(NumChunksFileName, Res),
|
|
( { Res = ok(OutputStream) } ->
|
|
io__write_int(OutputStream, NumChunks),
|
|
io__nl(OutputStream),
|
|
io__close_output(OutputStream),
|
|
{ Succeeded = yes }
|
|
;
|
|
{ Succeeded = no },
|
|
io__progname_base("mercury_compile", ProgName),
|
|
io__write_string(ProgName),
|
|
io__write_string(": can't open `"),
|
|
io__write_string(NumChunksFileName),
|
|
io__write_string("' for output\n")
|
|
).
|
|
|
|
read_num_split_c_files(ModuleName, MaybeNumChunks) -->
|
|
module_name_to_file_name(ModuleName, ".num_split", no,
|
|
NumChunksFileName),
|
|
io__open_input(NumChunksFileName, Res),
|
|
(
|
|
{ Res = ok(FileStream) },
|
|
io__read_word(FileStream, MaybeNumChunksString),
|
|
io__close_input(FileStream),
|
|
(
|
|
{ MaybeNumChunksString = ok(NumChunksString) },
|
|
(
|
|
{ string__to_int(
|
|
string__from_char_list(NumChunksString),
|
|
NumChunks) }
|
|
->
|
|
{ MaybeNumChunks = ok(NumChunks) }
|
|
;
|
|
{ MaybeNumChunks = error(
|
|
"Software error: error in `"
|
|
++ NumChunksFileName
|
|
++ "': expected single int.\n") }
|
|
)
|
|
;
|
|
{ MaybeNumChunksString = eof },
|
|
{ MaybeNumChunks = error(
|
|
"Software error: error in `"
|
|
++ NumChunksFileName
|
|
++ "': expected single int.\n") }
|
|
;
|
|
{ MaybeNumChunksString = error(_) },
|
|
{ MaybeNumChunks = error(
|
|
"Software error: error in `"
|
|
++ NumChunksFileName
|
|
++ "': expected single int.\n") }
|
|
)
|
|
;
|
|
{ Res = error(Error) },
|
|
{ MaybeNumChunks = error(io__error_message(Error)) }
|
|
).
|
|
|
|
remove_split_c_output_files(ModuleName, NumChunks) -->
|
|
remove_split_c_output_files(ModuleName, 0, NumChunks).
|
|
|
|
:- pred remove_split_c_output_files(module_name, int, int,
|
|
io__state, io__state).
|
|
:- mode remove_split_c_output_files(in,in, in, di, uo) is det.
|
|
|
|
remove_split_c_output_files(ModuleName, ThisChunk, NumChunks) -->
|
|
( { ThisChunk =< NumChunks } ->
|
|
globals__io_lookup_string_option(object_file_extension, Obj),
|
|
module_name_to_split_c_file_name(ModuleName, ThisChunk,
|
|
".c", CFileName),
|
|
module_name_to_split_c_file_name(ModuleName, ThisChunk,
|
|
Obj, ObjFileName),
|
|
io__remove_file(CFileName, _),
|
|
io__remove_file(ObjFileName, _),
|
|
remove_split_c_output_files(ModuleName, ThisChunk, NumChunks)
|
|
;
|
|
[]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
substitute_user_command(Command0, MainModule, AllModules) = Command :-
|
|
( string__contains_char(Command0, Char), (Char = ('@') ; Char = '%') ->
|
|
prog_out__sym_name_to_string(MainModule, ".", MainModuleStr),
|
|
AllModulesStrings = list__map(
|
|
(func(Module) = ModuleStr :-
|
|
prog_out__sym_name_to_string(Module, ".", ModuleStr)
|
|
), AllModules),
|
|
join_string_list(AllModulesStrings,
|
|
"", "", " ", AllModulesStr),
|
|
Command = string__from_rev_char_list(substitute_user_command_2(
|
|
string__to_char_list(Command0),
|
|
reverse(string__to_char_list(MainModuleStr)),
|
|
reverse(string__to_char_list(AllModulesStr)),
|
|
[]))
|
|
;
|
|
Command = Command0
|
|
).
|
|
|
|
:- func substitute_user_command_2(list(char), list(char),
|
|
list(char), list(char)) = list(char).
|
|
|
|
substitute_user_command_2([], _, _, RevChars) = RevChars.
|
|
substitute_user_command_2([Char | Chars], RevMainModule,
|
|
RevAllModules, RevChars0) =
|
|
(
|
|
( Char = ('@'), Subst = RevMainModule
|
|
; Char = '%', Subst = RevAllModules
|
|
)
|
|
->
|
|
( Chars = [Char | Chars2] ->
|
|
substitute_user_command_2(Chars2, RevMainModule,
|
|
RevAllModules, [Char | RevChars0])
|
|
;
|
|
substitute_user_command_2(Chars, RevMainModule,
|
|
RevAllModules, Subst ++ RevChars0)
|
|
)
|
|
;
|
|
substitute_user_command_2(Chars, RevMainModule,
|
|
RevAllModules, [Char | RevChars0])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|