%-----------------------------------------------------------------------------% % Copyright (C) 2002 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % File: 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 libs__globals. :- 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, module_imports, file_name, file_name, bool, io__state, io__state). :- mode compile_csharp_file(in, in, in, in, out, di, uo) is det. % make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded). % % 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. %-----------------------------------------------------------------------------% % maybe_pic_object_file_extension(G, P, E) is true iff % E is the extension which should be used on object files according % to the value of P. :- pred maybe_pic_object_file_extension(globals, pic, string). :- mode maybe_pic_object_file_extension(in, in, out) is det. :- mode maybe_pic_object_file_extension(in, out, in) is nondet. % Same as above except the globals, G, are obtained from the io__state. :- pred maybe_pic_object_file_extension(pic::in, string::out, io__state::di, io__state::uo) is det. %-----------------------------------------------------------------------------% :- implementation. :- import_module libs__options, libs__handle_options. :- import_module hlds__passes_aux, libs__trace_params. :- import_module parse_tree__prog_out. :- import_module backend_libs__foreign. :- import_module ll_backend__llds_out. % for llds_out__make_init_name and % llds_out__make_rl_data_name :- import_module char, dir, getopt, int, require, string. il_assemble(ErrorStream, ModuleName, HasMain, Succeeded) --> module_name_to_file_name(ModuleName, ".il", no, IL_File), module_name_to_file_name(ModuleName, ".dll", yes, DllFile), % % If the module contains main/2 then we it should be built as an % executable. Unfortunately MC++ or C# code may refer to the dll % so we always need to build the dll. % il_assemble(ErrorStream, IL_File, DllFile, no_main, DllSucceeded), ( { HasMain = has_main } -> module_name_to_file_name(ModuleName, ".exe", yes, ExeFile), il_assemble(ErrorStream, IL_File, ExeFile, HasMain, ExeSucceeded), { Succeeded = DllSucceeded `and` ExeSucceeded } ; { Succeeded = DllSucceeded } ). 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 = "/Zi " ; 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 = "-AIMercury/dlls " ++ string__append_list(list__condense(list__map( (func(DLLDir) = ["-AI", DLLDir, " "]), DLLDirs))) }, { string__append_list([MCPP, " -CLR ", DebugOpt, InclOpts, DLLDirOpts, MCPPFlags, " ", MCPPFileName, " -LD -o ", DLLFileName], Command) }, invoke_system_command(ErrorStream, verbose_commands, Command, Succeeded). compile_csharp_file(ErrorStream, Imports, CSharpFileName0, DLLFileName, Succeeded) --> globals__io_lookup_bool_option(verbose, Verbose), maybe_write_string(Verbose, "% Compiling `"), maybe_write_string(Verbose, CSharpFileName), 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) }, % XXX This is because the MS C# compiler doesn't understand % / as a directory seperator. { CSharpFileName = string__replace_all(CSharpFileName0, "/", "\\\\") }, globals__io_lookup_bool_option(target_debug, Debug), { Debug = yes -> % XXX This needs testing before it can be enabled % (see the comments for install_debug_library in % library/Mmakefile). % DebugOpt = "/debug+ /debug:full " DebugOpt = "" ; DebugOpt = "" }, % XXX Should we use a separate dll_directories options? globals__io_lookup_accumulating_option(link_library_directories, DLLDirs), { DLLDirOpts = "/lib:Mercury/dlls " ++ string__append_list(list__condense(list__map( (func(DLLDir) = ["/lib:", DLLDir, " "]), DLLDirs))) }, { mercury_std_library_module_name(Imports ^ module_name) -> Prefix = "/addmodule:" ; Prefix = "/r:" }, { ForeignDeps = list__map( (func(M) = foreign_import_module_name(M, Imports ^ module_name) ), Imports ^ foreign_import_module_info ) }, { ReferencedDlls = referenced_dlls(Imports ^ module_name, Imports ^ int_deps ++ Imports ^ impl_deps ++ ForeignDeps) }, list__map_foldl((pred(Mod::in, Result::out, di, uo) is det --> module_name_to_file_name(Mod, ".dll", no, FileName), { Result = [Prefix, FileName, " "] } ), ReferencedDlls, ReferencedDllsList), { ReferencedDllsStr = string__append_list( list__condense(ReferencedDllsList)) }, { string__append_list([CSC, DebugOpt, " /t:library ", DLLDirOpts, CSCFlags, ReferencedDllsStr, " /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 `.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 } ; % XXX should this use maybe_pic_object_file_extension? 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 ; cl ; unknown. compile_c_file(ErrorStream, PIC, ModuleName, Succeeded) --> module_name_to_file_name(ModuleName, ".c", yes, C_File), maybe_pic_object_file_extension(PIC, 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) }, { string__sub_string_search(CC, "gcc", _) -> CompilerType = gcc ; string__sub_string_search(CC, "lcc", _) -> CompilerType = lcc ; string__sub_string_search(string__to_lower(CC), "cl", _) -> CompilerType = cl ; CompilerType = unknown }, ( { 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(decl_debug, DeclDebug), { DeclDebug = yes -> DeclDebugOpt = "-DMR_DECL_DEBUG " ; DeclDebugOpt = "" }, 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 -> ( CompilerType = gcc, Target_DebugOpt = "-g " ; CompilerType = lcc, Target_DebugOpt = "-g " ; CompilerType = cl, Target_DebugOpt = "/Zi " ; CompilerType = unknown, 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 = "" }, 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, DeclDebugOpt, RequireTracingOpt, StackTraceOpt, 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) --> % XXX What is the difference between the PIC argument % and the setting of the `--pic' option here? % When can they be different? globals__io_lookup_bool_option(pic, PicOption), { ( PicOption = yes ; PIC = pic ) -> ReallyPic = pic, AsmExt = ".pic_s", GCCFLAGS_FOR_ASM = "-x assembler ", GCCFLAGS_FOR_PIC = "-fpic " ; ReallyPic = non_pic, AsmExt = ".s", GCCFLAGS_FOR_ASM = "", GCCFLAGS_FOR_PIC = "" }, module_name_to_file_name(ModuleName, AsmExt, no, AsmFile), maybe_pic_object_file_extension(ReallyPic, ObjExt), module_name_to_file_name(ModuleName, ObjExt, 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, GCCFLAGS_FOR_ASM, "-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) --> globals__io_lookup_bool_option(rebuild, MustCompile), 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, Ext), module_name_to_lib_file_name("lib", ModuleName, Ext, yes, OutputFileName), create_archive(ErrorStream, OutputFileName, ObjectsList, LinkSucceeded) ; ( { LinkTargetType = shared_library } -> { SharedLibOpt = "--make-shared-lib " }, { LDFlagsOpt = ld_libflags }, globals__io_lookup_string_option( shared_library_extension, Ext), module_name_to_lib_file_name("lib", ModuleName, Ext, yes, OutputFileName) ; { SharedLibOpt = "" }, { LDFlagsOpt = ld_flags }, globals__io_lookup_string_option( executable_file_extension, Ext), module_name_to_file_name(ModuleName, Ext, 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, LinkSucceeded) ), maybe_report_stats(Stats), globals__io_lookup_bool_option(use_grade_subdirs, UseGradeSubdirs), ( { LinkSucceeded = yes }, { UseGradeSubdirs = yes } -> % Link/copy the executable into the user's directory. globals__io_set_option(use_subdirs, bool(no)), globals__io_set_option(use_grade_subdirs, bool(no)), ( { LinkTargetType = executable } -> module_name_to_file_name(ModuleName, Ext, no, UserDirFileName) ; module_name_to_lib_file_name("lib", ModuleName, Ext, no, UserDirFileName) ), globals__io_set_option(use_subdirs, bool(yes)), globals__io_set_option(use_grade_subdirs, bool(yes)), io__set_output_stream(ErrorStream, OutputStream), make_symlink_or_copy_file(OutputFileName, UserDirFileName, Succeeded), io__set_output_stream(OutputStream, _) ; { Succeeded = LinkSucceeded } ). :- 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]) ). %-----------------------------------------------------------------------------% maybe_pic_object_file_extension(Globals, pic, Ext) :- globals__lookup_string_option(Globals, pic_object_file_extension, Ext). maybe_pic_object_file_extension(Globals, non_pic, Ext) :- globals__lookup_string_option(Globals, object_file_extension, Ext). maybe_pic_object_file_extension(PIC, ObjExt) --> globals__io_get_globals(Globals), { maybe_pic_object_file_extension(Globals, PIC, ObjExt) }. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------%