From 39760599e5936fe43215545206393be1310456b7 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Wed, 6 Jan 2016 18:35:27 +0100
Subject: [PATCH] Continue emiting functions and constants until everything is
 done

Since constants can contain functions, we need to check if there
is no new functions to handle after emiting constants.
---
 asmcomp/cmmgen.ml     | 22 +++++++++++++++++-----
 asmcomp/compilenv.ml  |  3 +++
 asmcomp/compilenv.mli |  1 +
 3 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index c3dc92926..cc18bad2f 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -2403,7 +2403,7 @@ let rec transl_all_functions already_translated cont =
         (transl_function f :: cont)
     end
   with Queue.Empty ->
-    cont
+    cont, already_translated
 
 (* Emit structured constants *)
 
@@ -2525,8 +2525,21 @@ let emit_all_constants cont =
         c := Cdata(emit_constant_closure symb fundecls clos_vars []) :: !c)
     !constant_closures;
   constant_closures := [];
+  Compilenv.clear_structured_constants ();
   !c
 
+let transl_all_functions_and_emit_all_constants cont =
+  let rec aux already_translated cont =
+    if Compilenv.structured_constants () = [] &&
+       Queue.is_empty functions
+    then cont
+    else
+      let cont, set = transl_all_functions already_translated cont in
+      let cont = emit_all_constants cont in
+      aux already_translated cont
+  in
+  aux StringSet.empty cont
+
 (* Build the table of GC roots for toplevel modules *)
 
 let emit_module_roots_table ~symbols cont =
@@ -2546,9 +2559,8 @@ let compunit size ulam =
                        fun_args = [];
                        fun_body = init_code; fun_fast = false;
                        fun_dbg  = Debuginfo.none }] in
-  let c2 = transl_all_functions StringSet.empty c1 in
-  let c3 = emit_all_constants c2 in
-  let c4 = emit_module_roots_table ~symbols:[glob] c3 in
+  let c2 = transl_all_functions_and_emit_all_constants c1 in
+  let c3 = emit_module_roots_table ~symbols:[glob] c2 in
   let space =
     (* These words will be registered as roots and as such must contain
        valid values, in case we are in no-naked-pointers mode.  Likewise
@@ -2560,7 +2572,7 @@ let compunit size ulam =
   in
   Cdata ([Cint(black_block_header 0 size);
          Cglobal_symbol glob;
-         Cdefine_symbol glob] @ space) :: c4
+         Cdefine_symbol glob] @ space) :: c3
 
 (*
 CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
diff --git a/asmcomp/compilenv.ml b/asmcomp/compilenv.ml
index 5ab48c95f..f39b07223 100644
--- a/asmcomp/compilenv.ml
+++ b/asmcomp/compilenv.ml
@@ -289,6 +289,9 @@ let new_structured_constant cst ~shared =
 let add_exported_constant s =
   Hashtbl.replace exported_constants s ()
 
+let clear_structured_constants () =
+  structured_constants := structured_constants_empty
+
 let structured_constants () =
   List.map
     (fun (lbl, cst) ->
diff --git a/asmcomp/compilenv.mli b/asmcomp/compilenv.mli
index 5263a6ca1..35bd9e441 100644
--- a/asmcomp/compilenv.mli
+++ b/asmcomp/compilenv.mli
@@ -66,6 +66,7 @@ val new_structured_constant:
   string
 val structured_constants:
   unit -> (string * bool * Clambda.ustructured_constant) list
+val clear_structured_constants: unit -> unit
 val add_exported_constant: string -> unit
 
 type structured_constants