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.
master
Pierre Chambart 2016-01-06 18:35:27 +01:00
parent 778eadccc6
commit 39760599e5
3 changed files with 21 additions and 5 deletions

View File

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

View File

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

View File

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