diff --git a/lib/miniImp/CfgRISC.ml b/lib/miniImp/CfgRISC.ml
index 2f86c3d..4494deb 100644
--- a/lib/miniImp/CfgRISC.ml
+++ b/lib/miniImp/CfgRISC.ml
@@ -755,10 +755,15 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
} ->
let initial_bindings =
match inputOutputVar with
- | Some (i, o) ->
- RegisterMap.empty |>
- RegisterMap.set_register i {index = "in"} |>
- RegisterMap.set_register o {index = "out"}
+ | Some (i, o) -> (
+ if i = o then
+ RegisterMap.empty |>
+ RegisterMap.set_register i {index = "in"}
+ else
+ RegisterMap.empty |>
+ RegisterMap.set_register i {index = "in"} |>
+ RegisterMap.set_register o {index = "out"}
+ )
| None ->
RegisterMap.empty
in
@@ -767,7 +772,16 @@ let convert (prg: CfgImp.SSCfg.t) : RISCCfg.t =
edges = edges;
reverseEdges = reverseEdges;
inputVal = inputVal;
- inputOutputVar = Some ("in", "out");
+ inputOutputVar = (
+ match inputOutputVar with
+ | Some (i, o) -> (
+ if i = o then
+ Some ("in", "in")
+ else
+ Some ("in", "out")
+ )
+ | None -> Some ("in", "out")
+ );
initial = initial;
terminal = terminal;
content = helper content initial_bindings;
diff --git a/lib/miniImp/liveVariables.ml b/lib/miniImp/liveVariables.ml
index 1987fee..1593592 100644
--- a/lib/miniImp/liveVariables.ml
+++ b/lib/miniImp/liveVariables.ml
@@ -18,7 +18,9 @@ module DVCfg = Dataflow.Make (CfgRISC.RISCSimpleStatements) (Variable)
module DVCeltSet = Set.Make(Variable)
-let variables_used (instr : DVCfg.elt) : DVCfg.internal list =
+let variables_used (instr : DVCfg.elt)
+ : DVCfg.internal list =
+
let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
match instr with
| Nop
@@ -51,6 +53,33 @@ let variables_defined (instructions : DVCfg.elt) : DVCfg.internal list =
helper DVCeltSet.empty instructions |> DVCeltSet.to_list
+let variables (instruction : DVCfg.elt) : DVCfg.internal list =
+ let helper (acc: DVCeltSet.t) (instr: DVCfg.elt) =
+ match instr with
+ | Nop -> acc
+ | Store (r1, r2) ->
+ DVCeltSet.add r1.index acc |>
+ DVCeltSet.add r2.index
+ | BRegOp (_, r1, r2, r3) ->
+ DVCeltSet.add r1.index acc |>
+ DVCeltSet.add r2.index |>
+ DVCeltSet.add r3.index
+ | BImmOp (_, r1, _, r3)
+ | URegOp (_, r1, r3)
+ | Load (r1, r3) ->
+ DVCeltSet.add r1.index acc |>
+ DVCeltSet.add r3.index
+ | LoadI (_, r3) ->
+ DVCeltSet.add r3.index acc
+ in
+
+ helper DVCeltSet.empty instruction |> DVCeltSet.to_list
+
+let variables_all (instructions : DVCfg.elt list) : DVCfg.internal list =
+ List.fold_left (fun (acc: DVCeltSet.t) (instr: DVCfg.elt) ->
+ DVCeltSet.union acc (variables instr |> DVCeltSet.of_list)
+ ) DVCeltSet.empty instructions |> DVCeltSet.to_list
+
(* init function, assign the bottom to everything *)
let init : (DVCfg.elt list -> DVCfg.internalnode) =
(fun l -> {internalin = [];
@@ -157,7 +186,7 @@ module VariableMap = struct
let start = "1" in
first_empty next start m l
- let get_mapping m l r =
+ let get_or_set_mapping m l r =
match find_opt r m with
| None -> (
let newr = first_empty_Variable m l in
@@ -179,33 +208,33 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(a, Nop)
)
| BRegOp (brop, r1, r2, r3) -> (
- let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
- let (newa, newr2) = VariableMap.get_mapping newa vin r2.index in
- let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+ let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
+ let (newa, newr2) = VariableMap.get_or_set_mapping newa vin r2.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, BRegOp (brop, {index = newr1}, {index = newr2}, {index = newr3}))
)
| BImmOp (biop, r1, i, r3) -> (
- let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
- let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+ let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, BImmOp (biop, {index = newr1}, i, {index = newr3}))
)
| URegOp (urop, r1, r3) -> (
- let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
- let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+ let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, URegOp (urop, {index = newr1}, {index = newr3}))
)
| Load (r1, r3) -> (
- let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
- let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+ let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, Load ({index = newr1}, {index = newr3}))
)
| LoadI (i, r3) -> (
- let (newa, newr3) = VariableMap.get_mapping a vout r3.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping a vout r3.index in
(newa, LoadI (i, {index = newr3}))
)
| Store (r1, r3) -> (
- let (newa, newr1) = VariableMap.get_mapping a vin r1.index in
- let (newa, newr3) = VariableMap.get_mapping newa vout r3.index in
+ let (newa, newr1) = VariableMap.get_or_set_mapping a vin r1.index in
+ let (newa, newr3) = VariableMap.get_or_set_mapping newa vout r3.index in
(newa, Store ({index = newr1}, {index = newr3}))
)
in
@@ -228,6 +257,7 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
livevars.internalbetween
code)
in
+
let newcontent = Cfg.NodeMap.add
node
newcode
@@ -240,14 +270,65 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
(* ------------------- *)
- let assignments = VariableMap.empty in
+ (* at least the input variable should be in the mapping *)
+ let assignments =
+ match t.t.inputOutputVar with
+ None -> VariableMap.empty
+ | Some (i, _o) -> (
+ VariableMap.get_or_set_mapping VariableMap.empty [] i |> fst
+ )
+ in
- let a, newt =
+ let all_variables = List.fold_left
+ (fun acc (_, code) ->
+ Utility.unique_union acc (variables_all code))
+ []
+ (Cfg.NodeMap.to_list t.t.content)
+ in
+
+ let mapping =
+ (* for each variable we get the union of all in and out that contains it
+ then we find a register such that it's not in conflict *)
+ List.fold_left (fun assignments v -> (
+ (* union of all in and out such that v is in the set *)
+ let union : 'a list =
+ List.fold_left
+ (fun (acc: 'a list) (node, (x: DVCfg.internalnode)) ->
+ (* not interested in internalin or internalout since information
+ is mirrored into internalbetween *)
+ List.fold_left2
+ (fun acc (i, o) code ->
+ (* we also consider the out set if we "use" v as a guard *)
+ match List.mem v i,
+ List.mem v o,
+ List.mem v (variables_defined code) with
+ | false, false, false -> acc
+ | true, false, false -> Utility.unique_union i acc
+ | false, false, true
+ | false, true, _ -> Utility.unique_union o acc
+ | true, false, true
+ | true, true, _ -> Utility.unique_union
+ (Utility.unique_union i o) acc
+ )
+ acc
+ x.internalbetween
+ (Cfg.NodeMap.find_opt node t.t.content |>
+ Option.value ~default:[])
+ )
+ []
+ (Cfg.NodeMap.to_list t.internalvar)
+ in
+ let assignments, _ = VariableMap.get_or_set_mapping assignments union v in
+ assignments
+ )) assignments all_variables
+ in
+
+ let mapping, newt =
Cfg.NodeSet.fold (* for each node we replace all the variables with the
optimized ones *)
(fun node (assign, t) -> aux assign t node)
t.t.nodes
- (assignments, t)
+ (mapping, t)
in
{ newt with
@@ -256,7 +337,8 @@ let optimize_cfg (t: DVCfg.t) : DVCfg.t =
match newt.t.inputOutputVar with
None -> None
| Some (i, o) -> (
- match VariableMap.find_opt i a, VariableMap.find_opt o a with
+ match VariableMap.find_opt i mapping,
+ VariableMap.find_opt o mapping with
| None, None -> Some (i, o)
| Some i, None -> Some (i, o)
| None, Some o -> Some (i, o)
diff --git a/report/document.pdf b/report/document.pdf
index 1974e01..ca50d9c 100644
Binary files a/report/document.pdf and b/report/document.pdf differ
diff --git a/report/document.tex b/report/document.tex
index fea0d5a..0889831 100644
--- a/report/document.tex
+++ b/report/document.tex
@@ -68,7 +68,7 @@
\usepackage{pgfornament} %% ornaments
%% load last
-\usepackage[hidelinks]{hyperref} %% links for table of contents, load last
+\usepackage{hyperref} %% links for table of contents, load last
\usepackage{bookmark} %% for better table of contents
diff --git a/report/report.tex b/report/report.tex
index d9b9fd2..e929a5f 100644
--- a/report/report.tex
+++ b/report/report.tex
@@ -23,8 +23,8 @@
\alt{} `\%' | `^' | `powmod' `(' `,' `,' `)' | `rand' `(' `)'
\end{grammar}
- Where \texttt{\%} is the modulo operator and \texttt{a a \% a} is the powermod operator;
- the variables are all integers, \texttt{n} is an integer and \texttt{v} is a boolean litteral.
+ Where \texttt{\%} is the modulo operator and the powmod operator is equivalent to \texttt{a \^{} a \% a};
+ the variables are all integers, \texttt{n} is an integer and \texttt{v} is a boolean literal.
The additional arithmetic expressions' semantics are implemented in a similar manner as with the other.
@@ -47,7 +47,8 @@
A program \texttt{t} is defined as follows:
\begin{grammar}
\(\defeq\) | | | `(' `,' `)'
- \alt{} `fun' `:' `=>' | | | % chktex 38
+ \alt{} `fun' `:' `=>' | % chktex 38
+ \alt{} |
\alt{} `powmod' `(' `,' `,' `)'
\alt{} `rand' `(' `)' |
\alt{} `if' `then' `else'
diff --git a/test/dune b/test/dune
index c173233..1b83215 100644
--- a/test/dune
+++ b/test/dune
@@ -10,6 +10,10 @@
(name testingRISC)
(libraries miniImp))
+(test
+ (name testingAnalysis)
+ (libraries miniImp))
+
(test
(name testingFun)
(libraries miniFun))
diff --git a/test/testingAnalysis.expected b/test/testingAnalysis.expected
new file mode 100644
index 0000000..bc5b107
--- /dev/null
+++ b/test/testingAnalysis.expected
@@ -0,0 +1,8 @@
+Identity program: 1
+Factorial program: 3628800
+Hailstone sequence's lenght program: 351
+Sum multiples of 3 and 5 program: 35565945
+Rand program: true
+Fibonacci program: 4807526976
+Miller-Rabin primality test program 1: 0
+Miller-Rabin primality test program 2: 1
diff --git a/test/testingAnalysis.ml b/test/testingAnalysis.ml
new file mode 100644
index 0000000..48d1c7a
--- /dev/null
+++ b/test/testingAnalysis.ml
@@ -0,0 +1,132 @@
+open MiniImp
+
+let compute x i =
+ Lexing.from_string x |>
+ Parser.prg Lexer.lex |>
+ CfgImp.convert_io i |>
+ CfgRISC.convert |>
+ LiveVariables.compute_live_variables |>
+ LiveVariables.optimize_cfg |>
+ LiveVariables.compute_cfg |>
+ ReduceRegisters.reduceregisters 4 |>
+ RISC.convert |>
+ RISCSemantics.reduce
+
+(* -------------------------------------------------------------------------- *)
+(* Identity program *)
+let program =
+ "def main with input a output b as b := a"
+;;
+
+Printf.printf "Identity program: ";
+Printf.printf "%d\n" (compute program 1)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Factorial program *)
+let program =
+"def main with input a output b as
+ b := 1;
+ for (i := 1, i <= a, i := i + 1) do
+ b := b * i;
+"
+;;
+
+Printf.printf "Factorial program: ";
+Printf.printf "%d\n" (compute program 10)
+
+(* -------------------------------------------------------------------------- *)
+(* Hailstone sequence's lenght program *)
+let program =
+"def main with input a output b as
+ b := 1;
+ while not a == 1 do (
+ b := b + 1;
+ if ((a % 2) == 1) then a := 3 * a + 1 else a := a / 2
+ )
+"
+;;
+
+Printf.printf "Hailstone sequence's lenght program: ";
+Printf.printf "%d\n" (compute program 77031)
+
+(* -------------------------------------------------------------------------- *)
+(* Sum multiples of 3 and 5 program *)
+let program =
+"def main with input a output b as
+ b := 0;
+ for (i := 0, i <= a, i := i+1) do
+ if (i % 3 == 0 || i % 5 == 0) then b := b + i;
+ else skip;
+"
+;;
+
+Printf.printf "Sum multiples of 3 and 5 program: ";
+Printf.printf "%d\n" (compute program 12345)
+
+(* -------------------------------------------------------------------------- *)
+(* Rand program *)
+let program =
+ "def main with input a output b as b := rand(a)"
+;;
+
+Printf.printf "Rand program: ";
+Printf.printf "%b\n" ((compute program 10) < 10)
+
+(* -------------------------------------------------------------------------- *)
+(* Fibonacci program *)
+let program =
+"def main with input n output fnext as
+ fnow := 0;
+ fnext := 1;
+ while (n > 1) do (
+ tmp := fnow + fnext;
+ fnow := fnext;
+ fnext := tmp;
+ n := n - 1;
+ )
+"
+;;
+
+Printf.printf "Fibonacci program: ";
+Printf.printf "%d\n" (compute program 48)
+
+(* -------------------------------------------------------------------------- *)
+(* Miller-Rabin primality test program *)
+let program =
+"def main with input n output result as
+ if (n % 2) == 0 then result := 1
+ else (
+
+ result := 0;
+ s := 0;
+ while (0 == ((n - 1) / (2 ^ s)) % 2) do (
+ s := s + 1
+ );
+ d := ((n - 1) / 2 ^ s);
+ for (i := 20, i > 0, i := i - 1) do (
+ a := rand(n - 4) + 2;
+ x := powmod(a, d, n);
+ y := 0;
+ for (j := 0, j < s, j := j+1) do (
+ y := powmod(x, 2, n);
+ if (y == 1 && (not x == 1) && (not x == n - 1)) then
+ result := 1;
+ else
+ skip;
+ x := y;
+ );
+ if not y == 1 then result := 1;
+ else skip;
+ )
+ )
+"
+;;
+
+(* should return 0 because prime *)
+Printf.printf "Miller-Rabin primality test program 1: ";
+Printf.printf "%d\n" (compute program 179424673);
+
+(* should return 1 because not prime *)
+Printf.printf "Miller-Rabin primality test program 2: ";
+Printf.printf "%d\n" (compute program 179424675);
diff --git a/test/testingImpParser.ml b/test/testingImpParser.ml
index dcacecd..7aad165 100644
--- a/test/testingImpParser.ml
+++ b/test/testingImpParser.ml
@@ -134,6 +134,7 @@ let program =
for (i := 20, i > 0, i := i - 1) do (
a := rand(n - 4) + 2;
x := powmod(a, d, n);
+ y := 0;
for (j := 0, j < s, j := j+1) do (
y := powmod(x, 2, n);
if (y == 1 && (not x == 1) && (not x == n - 1)) then