diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2007-08-04 07:27:50 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2007-08-04 07:27:50 +0000 |
commit | 355b4abcee015c3fae9ac5653c25259e104a886c (patch) | |
tree | cfdb5b17f36b815bb358699cf420f64eba9dfe25 /caml/RTLgenaux.ml | |
parent | 22ff08b38616ceef336f5f974d4edc4d37d955e8 (diff) | |
download | compcert-355b4abcee015c3fae9ac5653c25259e104a886c.tar.gz compcert-355b4abcee015c3fae9ac5653c25259e104a886c.zip |
Fusion des modifications faites sur les branches "tailcalls" et "smallstep".
En particulier:
- Semantiques small-step depuis RTL jusqu'a PPC
- Cminor independant du processeur
- Ajout passes Selection et Reload
- Ajout des langages intermediaires CminorSel et LTLin correspondants
- Ajout des tailcalls depuis Cminor jusqu'a PPC
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@384 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'caml/RTLgenaux.ml')
-rw-r--r-- | caml/RTLgenaux.ml | 46 |
1 files changed, 45 insertions, 1 deletions
diff --git a/caml/RTLgenaux.ml b/caml/RTLgenaux.ml index 336346af..61abecfa 100644 --- a/caml/RTLgenaux.ml +++ b/caml/RTLgenaux.ml @@ -1,3 +1,47 @@ -open Cminor +open Switch +open CminorSel let more_likely (c: condexpr) (ifso: stmt) (ifnot: stmt) = false + +module IntOrd = + struct + type t = Integers.int + let compare x y = + if Integers.Int.eq x y then 0 else + if Integers.Int.ltu x y then -1 else 1 + end + +module IntSet = Set.Make(IntOrd) + +let normalize_table tbl = + let rec norm seen = function + | CList.Coq_nil -> [] + | CList.Coq_cons(Datatypes.Coq_pair(key, act), rem) -> + if IntSet.mem key seen + then norm seen rem + else (key, act) :: norm (IntSet.add key seen) rem + in norm IntSet.empty tbl + +let compile_switch default table = + let sw = Array.of_list (normalize_table table) in + Array.stable_sort (fun (n1, _) (n2, _) -> IntOrd.compare n1 n2) sw; + let rec build lo hi = + match hi - lo with + | 0 -> + CTaction default + | 1 -> + CTifeq(fst sw.(lo), snd sw.(lo), CTaction default) + | 2 -> + CTifeq(fst sw.(lo), snd sw.(lo), + CTifeq(fst sw.(lo+1), snd sw.(lo+1), + CTaction default)) + | 3 -> + CTifeq(fst sw.(lo), snd sw.(lo), + CTifeq(fst sw.(lo+1), snd sw.(lo+1), + CTifeq(fst sw.(lo+2), snd sw.(lo+2), + CTaction default))) + | _ -> + let mid = (lo + hi) / 2 in + CTiflt(fst sw.(mid), build lo mid, build mid hi) + in build 0 (Array.length sw) + |