cmmgen: partage des litteraux
closure: broutille git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1230 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
d67218a490
commit
3597ec5e9a
|
@ -59,7 +59,8 @@ let occurs_var var u =
|
||||||
| Uwhile(cond, body) -> occurs cond or occurs body
|
| Uwhile(cond, body) -> occurs cond or occurs body
|
||||||
| Ufor(id, lo, hi, dir, body) -> occurs lo or occurs hi or occurs body
|
| Ufor(id, lo, hi, dir, body) -> occurs lo or occurs hi or occurs body
|
||||||
| Uassign(id, u) -> id = var or occurs u
|
| Uassign(id, u) -> id = var or occurs u
|
||||||
| Usend(met, obj, args) -> List.exists occurs (met::obj::args)
|
| Usend(met, obj, args) ->
|
||||||
|
occurs met or occurs obj or List.exists occurs args
|
||||||
and occurs_array a =
|
and occurs_array a =
|
||||||
try
|
try
|
||||||
for i = 0 to Array.length a - 1 do
|
for i = 0 to Array.length a - 1 do
|
||||||
|
|
|
@ -371,7 +371,8 @@ let new_const_symbol () =
|
||||||
incr const_label;
|
incr const_label;
|
||||||
Compilenv.current_unit_name () ^ "_" ^ string_of_int !const_label
|
Compilenv.current_unit_name () ^ "_" ^ string_of_int !const_label
|
||||||
|
|
||||||
let structured_constants = ref ([] : (string * structured_constant) list)
|
let structured_constants =
|
||||||
|
(Hashtbl.create 19 : (structured_constant, string) Hashtbl.t)
|
||||||
|
|
||||||
let transl_constant = function
|
let transl_constant = function
|
||||||
Const_base(Const_int n) ->
|
Const_base(Const_int n) ->
|
||||||
|
@ -381,9 +382,14 @@ let transl_constant = function
|
||||||
| Const_pointer n ->
|
| Const_pointer n ->
|
||||||
Cconst_pointer((n lsl 1) + 1)
|
Cconst_pointer((n lsl 1) + 1)
|
||||||
| cst ->
|
| cst ->
|
||||||
let lbl = new_const_symbol() in
|
let lbl =
|
||||||
structured_constants := (lbl, cst) :: !structured_constants;
|
try
|
||||||
Cconst_symbol lbl
|
Hashtbl.find structured_constants cst
|
||||||
|
with Not_found ->
|
||||||
|
let lbl = new_const_symbol() in
|
||||||
|
Hashtbl.add structured_constants cst lbl;
|
||||||
|
lbl
|
||||||
|
in Cconst_symbol lbl
|
||||||
|
|
||||||
(* Translate an expression *)
|
(* Translate an expression *)
|
||||||
|
|
||||||
|
@ -927,12 +933,13 @@ and emit_string_constant s cont =
|
||||||
|
|
||||||
(* Emit all structured constants *)
|
(* Emit all structured constants *)
|
||||||
|
|
||||||
let rec emit_all_constants cont =
|
let emit_all_constants cont =
|
||||||
match !structured_constants with
|
let c = ref cont in
|
||||||
[] -> cont
|
Hashtbl.iter
|
||||||
| (lbl, cst) :: rem ->
|
(fun cst lbl -> c := Cdata(emit_constant lbl cst []) :: !c)
|
||||||
structured_constants := rem;
|
structured_constants;
|
||||||
emit_all_constants (Cdata(emit_constant lbl cst []) :: cont)
|
Hashtbl.clear structured_constants;
|
||||||
|
!c
|
||||||
|
|
||||||
(* Translate a compilation unit *)
|
(* Translate a compilation unit *)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue