Skip to content

Commit

Permalink
fix issue #171
Browse files Browse the repository at this point in the history
  • Loading branch information
melsman committed May 11, 2024
1 parent 85a57c5 commit 0b203d7
Show file tree
Hide file tree
Showing 3 changed files with 71 additions and 27 deletions.
6 changes: 6 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,11 @@
## MLKit NEWS

* mael 2024-05-11: Provide support for a new flag `-objs` that together with
`-no_delete_target_files` will allow the user to see which object-files are to
be linked. The object files, including the file `base_object_file.o` are
reported in the file `run` or `f.objs` if `-output f.objs` is given as
argument to the `mlkit` command (issue #171).

* mael 2024-03-06: Use C99 flexible C structs for ML strings and
tables (internal cleanup).

Expand Down
72 changes: 53 additions & 19 deletions src/Compiler/Backend/X64/ExecutionX64.sml
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,17 @@ structure ExecutionX64: EXECUTION =
Flags.add_bool_entry
{long="strip", short=NONE, neg=false, item=ref false,
menu=["General Control", "strip executable"],
desc="If enabled, the Kit strips the generated executable."}
desc="If enabled, MLKit strips the generated executable."}

val objs_p =
Flags.add_bool_entry
{long="objs", short=NONE, neg=false, item=ref false,
menu=["General Control", "export object files"],
desc="If enabled, MLKit writes object-file paths to the file\n\
\run or the file specified by -output. The path\n\
\to the runtime system (archive file) is included. The\n\
\option is best used together with the option\n\
\-no_delete_target_files."}

val delete_target_files =
Flags.add_bool_entry
Expand Down Expand Up @@ -261,7 +271,11 @@ structure ExecutionX64: EXECUTION =

val generate_repl_init_code = SOME (fn () => CodeGen.generate_repl_init_code())

fun delete_file f = OS.FileSys.remove f handle _ => ()
fun delete_file f =
let val () = if debug_linking() then print ("[Removing file: " ^ f ^ "]\n")
else ()
in OS.FileSys.remove f handle _ => ()
end

fun execute_command cmd : unit =
let val () = if debug_linking() then print ("[Executing: " ^ cmd ^ "]\n")
Expand Down Expand Up @@ -295,24 +309,44 @@ structure ExecutionX64: EXECUTION =
handle _ => ())
else ()

fun writeFile f s =
let val os = TextIO.openOut f
in ( TextIO.output(os,s)
; TextIO.flushOut os
; TextIO.closeOut os
) handle ? => (TextIO.closeOut os; raise ?)
end

fun link_files_with_runtime_system0 path_to_runtime files run =
let val files = map (fn s => s ^ " ") files
val libdirs =
case libdirs() of
"" => ""
| libdirs => " " ^ libdirsConvertList libdirs

val pthread = if parallelism_p() andalso not(onmac_p())
then " -pthread"
else ""
val shell_cmd = link_exe() ^ " -o " ^ run ^ " " ^
concat files ^ path_to_runtime() ^ libdirs ^ libConvertList(libs()) ^ pthread
in
execute_command shell_cmd;
strip run;
message(fn () => "[wrote executable file:\t" ^ run ^ "]\n");
report_dangle_stat()
end
if objs_p()
then let val files =
path_to_runtime() :: files
val content = String.concatWith " " files ^ "\n"
in writeFile run content
; message (fn () => "[wrote object file paths to file:\t" ^ run ^ "]\n")
; report_dangle_stat()
end
handle ? =>
( message (fn () => "[** Failed to write object file paths to the file:\t" ^ run ^ "]\n")
; report_dangle_stat())
else
let val files = map (fn s => s ^ " ") files
val libdirs =
case libdirs() of
"" => ""
| libdirs => " " ^ libdirsConvertList libdirs

val pthread = if parallelism_p() andalso not(onmac_p())
then " -pthread"
else ""
val shell_cmd = link_exe() ^ " -o " ^ run ^ " " ^
concat files ^ path_to_runtime() ^ libdirs ^ libConvertList(libs()) ^ pthread
in
execute_command shell_cmd;
strip run;
message(fn () => "[wrote executable file:\t" ^ run ^ "]\n");
report_dangle_stat()
end

val op ## = OS.Path.concat infix ##

Expand Down
20 changes: 12 additions & 8 deletions src/Manager/ManagerObjects.sml
Original file line number Diff line number Diff line change
Expand Up @@ -37,11 +37,11 @@ functor ManagerObjects(
Flags.add_bool_entry {long="link_time_dead_code_elimination", short=SOME "ltdce", item=ref true,
menu=["Control", "link time dead code elimination"], neg=true,
desc="Link time dead code elimination."}
local
val debug_linking = Flags.lookup_flag_entry "debug_linking"
in
fun pr_debug_linking s = if !debug_linking then print s else ()
end

val debug_linking = Flags.is_on0 "debug_linking"
fun pr_debug_linking s = if debug_linking() then print s else ()

val delete_target_files = Flags.is_on0 "delete_target_files"

(*
* Modification times of files
Expand Down Expand Up @@ -71,8 +71,11 @@ functor ManagerObjects(
* Deleting a file
* -------------------- *)

fun delete_file f = OS.FileSys.remove f handle _ => ()

fun delete_file f =
let val () = if debug_linking() then print ("[Removing file: " ^ f ^ "]\n")
else ()
in OS.FileSys.remove f handle _ => ()
end

(* -----------------------------------------------
* Creating directories for target code
Expand Down Expand Up @@ -241,7 +244,8 @@ functor ManagerObjects(
let val target_link = generate_link_code (labs, exports)
val linkfile_o = emit(target_link, "base", "link_objects")
in link_files_with_runtime_system (linkfile_o :: (target_files @ extobjs)) run;
delete_file linkfile_o
(if delete_target_files() then delete_file linkfile_o
else ())
end
| NONE =>
link_files_with_runtime_system target_files run
Expand Down

0 comments on commit 0b203d7

Please sign in to comment.