diff options
author | Bernhard Schommer <bernhardschommer@gmail.com> | 2017-11-08 09:41:38 +0100 |
---|---|---|
committer | Bernhard Schommer <bernhardschommer@gmail.com> | 2017-11-08 09:41:38 +0100 |
commit | 9e9c57616c9cf683ed65b1ba60510b8ae8066700 (patch) | |
tree | a391327cde328b9decb81b683563a87c0f7d9554 /backend/PrintAsmaux.ml | |
parent | 43b557ce847b56c1cfae2081c7585191043a85b6 (diff) | |
download | compcert-9e9c57616c9cf683ed65b1ba60510b8ae8066700.tar.gz compcert-9e9c57616c9cf683ed65b1ba60510b8ae8066700.zip |
Simplifiy handling of constant emmitting.
Instead of just storing the constants in a list, they are now
stored in a hashtable. This avoids printing of duplicates.
Bug 22525
Diffstat (limited to 'backend/PrintAsmaux.ml')
-rw-r--r-- | backend/PrintAsmaux.ml | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index 4099d76f..f7a30b22 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -69,15 +69,30 @@ let elf_label oc lbl = (* List of literals and jumptables used in the code *) -let float64_literals : (int * int64) list ref = ref [] -let float32_literals : (int * int32) list ref = ref [] -let int64_literals : (int * int64) list ref = ref [] let jumptables : (int * label list) list ref = ref [] + +let label_constant (h: ('a, int) Hashtbl.t) (cst: 'a) = + try + Hashtbl.find h cst + with Not_found -> + let lbl = new_label() in + Hashtbl.add h cst lbl; + lbl + +let literal32_labels = (Hashtbl.create 39 : (int32, int) Hashtbl.t) +let literal64_labels = (Hashtbl.create 39 : (int64, int) Hashtbl.t) + +let label_literal32 bf = label_constant literal32_labels bf +let label_literal64 n = label_constant literal64_labels n + let reset_constants () = - float64_literals := []; - float32_literals := []; - jumptables := [] + jumptables := []; + Hashtbl.clear literal32_labels; + Hashtbl.clear literal64_labels + +let exists_constants () = + Hashtbl.length literal32_labels > 0 || Hashtbl.length literal64_labels > 0 (* Variables used for the handling of varargs *) |