mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 22:35:41 +00:00
ed83fe4623
Estimated hours taken: 12
Branches: main
Optimize shallow traced modules by not adding calls to MR_trace to shallow
traced procedures which cannot be called from a deep traced environment.
A shallow traced procedure can be optimized in this way if it is neither
exported from its defining module nor has its address taken.
The main purpose of this optimization is not the avoidance of the cost of the
MR_trace calls as much as it is the restoration of tail recursion optimization.
Previously, compiling a program in a debug grade would disable all tail
recursion in the program (since debug grades require at least shallow tracing
every module). This was a problem because it limited the sizes of the inputs
the debugged program could process before running out of memory. As long as
the procedures that recurse on the input are in the implementation section
of a shallow traced module, this should no longer happen.
compiler/trace_params.m:
Introduce the concept of a procedure's effective trace level. This is
identical to the global trace level, except if the procedure is not
exported and doesn't have its address taken, and the global trace level
is shallow. In that case, we say that the procedure's effective trace
level is none.
Computing a procedure's effective trace level requires its proc_info
and its parent pred_info, so require callers to supply these as
parameters.
compiler/code_info.m:
Store the current pred_info as well as the current proc_info, for
trace parameter lookups.
compiler/continuation_info.m:
compiler/code_gen.m:
Record the required trace parameters of a procedure in its layout
structure, since it can no longer be computed from the global trace
level.
compiler/stack_layout.m:
Use the trace parameters in procedures' layout structures, instead of
trying to compute them from the global trace level.
compiler/inlining.m:
compiler/liveness.m:
compiler/stack_alloc.m:
compiler/store_alloc.m:
compiler/trace.m:
Use procedures' effective trace level instead of the global trace level
where relevant.
compiler/llds.m:
Record the required trace parameter of a procedure in its c_procedure
representation, since it can no longer be computed from the global
trace level.
Delete an obsolete field.
compiler/optimize.m:
compiler/jumpopt.m:
Use a required trace parameter of a procedure in its c_procedure
representation, since it can no longer be computed from the global
trace level.
compiler/compile_target_code.m:
compiler/handle_options.m:
compiler/llds_out.m:
compiler/mercury_compile.m:
Trivial changes to conform to updated interfaces.
compiler/stack_opt.m:
Use the option opt_no_return_calls, instead of approximating it
with the trace level. (The old code was a holdover from before the
creation of the option.)
tests/debugger/shallow.m:
tests/debugger/shallow2.m:
tests/debugger/shallow.{inp,exp*}:
Divide the old test case in shallow.m in two. The top level predicates
stay in shallow.m and continue to be shallow traced. The two bottom
predicates move to shallow2.m and are now deep traced.
The new test input checks whether the debugger can walk across the
stack frames of procedures in shallow traced modules whose effective
trace level is "none" (such as queen/2).
1179 lines
39 KiB
Mathematica
1179 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 = conservative ->
|
|
GC_Opt = "-DMR_CONSERVATIVE_GC "
|
|
; GC_Method = accurate ->
|
|
GC_Opt = "-DMR_NATIVE_GC "
|
|
;
|
|
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 ", 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_string_list(InitFileDirsList, "-I ", "", " ", InitFileDirs) },
|
|
|
|
globals__io_lookup_accumulating_option(init_files, InitFileNamesList),
|
|
{ join_string_list(InitFileNamesList, "", "", " ", InitFileNames) },
|
|
|
|
globals__io_lookup_accumulating_option(trace_init_files,
|
|
TraceInitFileNamesList),
|
|
{ join_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_string_list(LinkLibraryDirectoriesList, "-L", "",
|
|
" ", LinkLibraryDirectories) },
|
|
globals__io_lookup_accumulating_option(link_libraries,
|
|
LinkLibrariesList),
|
|
{ join_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)
|
|
).
|
|
|
|
% 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])
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|