Support for reporting object-files (#173)

* fix issue #171
* fix macos github runner to be macos-12
* make mlton compilation more verbose
* increase github actions timeout

.github/workflows/main.yml

@@ -27,7 +27,7 @@ jobs:
 
     strategy:
       matrix:
-        os: [ubuntu-20.04, macos-latest]
+        os: [ubuntu-20.04, macos-12]
         mlcomp: [mlkit, mlton]
 #        mlcomp: [mlton]
 #        mlcomp: [mlkit]
@@ -100,7 +100,7 @@ jobs:
         if: ${{ matrix.mlcomp == 'mlton' }}
         run: |
           ./autobuild
-          ./configure
+          ./configure --with-compiler='mlton @MLton ram-slop 0.7 -- -drop-pass deepFlatten -drop-pass refFlatten -verbose 2'
 
       - name: Configure With MLKit
         if: ${{ matrix.mlcomp == 'mlkit' }}
@@ -109,6 +109,7 @@ jobs:
           ./configure --with-compiler=mlkit
 
       - name: Build MLKit
+        timeout-minutes: 120
         run: |
           make mlkit
           make mlkit_basislibs

NEWS.md

@@ -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).
 

src/Compiler/Backend/X64/ExecutionX64.sml

@@ -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
@@ -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")
@@ -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 ##
 

src/Manager/ManagerObjects.sml

@@ -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.lookup_flag_entry "debug_linking"
+    fun pr_debug_linking s = if !debug_linking then print s else ()
+
+    fun delete_target_files () = Flags.is_on "delete_target_files"
 
     (*
      * Modification times of files
@@ -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
@@ -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