elvis/lci
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixes for RISC evaluation

Browse Source
This commit is contained in:
elvis
2025-01-11 20:32:11 +01:00
parent 3be05222ab
commit 9bcc88e016
11 changed files with 261 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
bin/dune
View File

@ -27,3 +27,12 @@
(package miniImp)
(modes byte exe)
)
(executable
(name miniImpInterpreterReg)
(public_name miniImpInterpreterReg)
(libraries miniImp
clap)
(package miniImp)
(modes byte exe)
)

2
bin/miller-rabin.miniimp
View File

@ -1,7 +1,6 @@
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 (
@ -11,6 +10,7 @@ def main with input n output result as
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

3
bin/miniImpInterpreter.ml
View File

@ -58,7 +58,8 @@ let () =
| Lexer.LexingError msg ->
Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
exit (-1)
| Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
| Parser.Error ->
Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
exit (-1)
in
let return_value =

119
bin/miniImpInterpreterReg.ml Normal file
View File

@ -0,0 +1,119 @@
open MiniImp
open Lexing
(* -------------------------------------------------------------------------- *)
(* Command Arguments *)
let () =
Clap.description "Interpreter for MiniImp language.";
let files = Clap.section ~description: "Files to consider." "FILES" in
let values = Clap.section ~description: "Input values." "VALUES" in
let input = Clap.mandatory_string
~description: "Input file."
~placeholder: "FILENAME"
~section: files
~long: "input"
~short: 'i'
()
in
let registers = Clap.default_int
~description: "Optional number of registers available."
~placeholder: "INT"
~section: values
~long: "registers"
~short: 'r'
4
in
let evalb = Clap.flag
~description: "Optional flag for evaluating the generated risc code."
~section: values
~set_long: "eval"
~set_short: 'e'
false
in
let inputval = Clap.default_int
~description: "Optional input value to feed to the program. \
If not specified it is read from stdin."
~placeholder: "INT"
~section: values
~long: "value"
~short: 'v'
0
in
let output = Clap.optional_string
~description: "Output file. If not specified output is printed on stdout."
~placeholder: "FILENAME"
~section: files
~long: "output"
~long_synonyms: ["out"; "result"]
~short: 'o'
()
in
Clap.close ();
(* -------------------------------------------------------------------------- *)
(* Interpreter *)
let print_position outx lexbuf =
let pos = lexbuf.lex_curr_p in
Printf.fprintf outx "Encountered \"%s\" at %s:%d:%d"
(Lexing.lexeme lexbuf) pos.pos_fname
pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
in
let interpret_file inch (registers: int) outch =
let lexbuf = Lexing.from_channel inch in
let program =
try Parser.prg Lexer.read lexbuf with
| Lexer.LexingError msg ->
Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
exit (-1)
| Parser.Error ->
Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
exit (-1)
in
let return_value =
program |>
CfgImp.convert_io inputval |>
CfgRISC.convert
in
let () = (
match DefinedVariables.compute_defined_variables return_value |>
DefinedVariables.check_undefined_variables
with
| None -> ()
| Some l ->
Printf.printf "Error: undefined variables: %a\n"
DefinedVariables.Variable.pplist l;
exit (-1)
) in
let return_value =
return_value |>
LiveVariables.compute_live_variables |>
LiveVariables.optimize_cfg |>
LiveVariables.compute_cfg |>
ReduceRegisters.reduceregisters registers |>
RISC.convert
in
if not evalb
then Printf.fprintf outch "%a\n" RISC.RISCAssembly.pp return_value
else Printf.fprintf outch "%d\n" (RISCSemantics.reduce return_value)
in
let inx = In_channel.open_text input in
let outx = match output with
None -> stdout
| Some f -> Out_channel.open_text f
in
interpret_file inx registers outx;

25
bin/test.miniimp Normal file
View File

@ -0,0 +1,25 @@
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;
)
)

35
lib/analysis/Cfg.ml
View File

@ -20,6 +20,7 @@ end
module NodeMap = struct
include Map.Make(Node)
(* adds the input to the tail of the list for the associated node *)
let add_to_list_last x data m =
let add = function None -> Some [data]
| Some l -> Some (l @ [data]) in
@ -80,12 +81,14 @@ module Make (M: PrintableType) = struct
nodes = NodeSet.union cfg1.nodes cfg2.nodes |>
NodeSet.add entryNode |>
NodeSet.add exitNode;
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.edges cfg2.edges |>
NodeMap.add entryNode (cfg1initial, Some cfg2initial) |>
NodeMap.add cfg1terminal (exitNode, None) |>
NodeMap.add cfg2terminal (exitNode, None);
reverseEdges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
reverseEdges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.reverseEdges cfg2.reverseEdges |>
NodeMap.add_to_list cfg1initial entryNode |>
NodeMap.add_to_list cfg2initial entryNode |>
@ -95,7 +98,8 @@ module Make (M: PrintableType) = struct
inputOutputVar = cfg1.inputOutputVar;
initial = Some entryNode;
terminal = Some exitNode;
content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
content = NodeMap.union
(fun _ -> failwith "Failed merging code of cfg.")
cfg1.content cfg2.content
}
@ -110,17 +114,20 @@ module Make (M: PrintableType) = struct
let cfg2terminal = Option.get cfg2.terminal in
{ empty = false;
nodes = NodeSet.union cfg1.nodes cfg2.nodes;
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
cfg1.edges cfg2.edges |>
edges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.edges cfg2.edges |>
NodeMap.add cfg1terminal (cfg2initial, None);
reverseEdges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
reverseEdges = NodeMap.union
(fun _ -> failwith "Failed merging edges of cfg.")
cfg1.reverseEdges cfg2.reverseEdges |>
NodeMap.add_to_list cfg2initial cfg1terminal;
inputVal = cfg1.inputVal;
inputOutputVar = cfg1.inputOutputVar;
initial = Some cfg1initial;
terminal = Some cfg2terminal;
content = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
content = NodeMap.union
(fun _ -> failwith "Failed merging code of cfg.")
cfg1.content cfg2.content
}
@ -147,14 +154,18 @@ module Make (M: PrintableType) = struct
let pp (ppf) (c: t) : unit =
Printf.fprintf ppf "Nodes' ids: ";
List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.nodes);
List.iter
(fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id)
(NodeSet.to_list c.nodes);
Printf.fprintf ppf "\n";
Printf.fprintf ppf "Nodes' edges:\n";
List.iter (fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
match b with None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
| Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id
) (NodeMap.to_list c.edges);
List.iter
(fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
match b with
None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
| Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id )
(NodeMap.to_list c.edges);
Printf.fprintf ppf "\n";
Printf.fprintf ppf "Nodes' back edges:\n";

6
lib/analysis/Dataflow.ml
View File

@ -18,7 +18,11 @@ module type C = sig
val from_cfg : cfgt -> t
val to_cfg : t -> cfgt
val fixed_point : ?init:(elt list -> internalnode) -> ?update:(t -> Cfg.Node.t -> internalnode) -> t -> t
val fixed_point :
?init:(elt list -> internalnode) ->
?update:(t -> Cfg.Node.t -> internalnode) ->
t ->
t
val pp : out_channel -> t -> unit
end

14
lib/miniImp/RISC.ml
View File

@ -116,9 +116,13 @@ module RISCAssembly = struct
let pp (ppf: out_channel) (t: t) : unit =
Printf.fprintf ppf "Input Val: ";
match t.inputval with
None -> Printf.fprintf ppf "None\n"
| Some i -> Printf.fprintf ppf "Some %d\n" i;
( match t.inputval with
None -> Printf.fprintf ppf "None\n"
| Some i -> Printf.fprintf ppf "Some %d\n" i );
Printf.fprintf ppf "Input/Output Registers: ";
( match t.inputoutputreg with
None -> Printf.fprintf ppf "None\n"
| Some (i, o) -> Printf.fprintf ppf "[i: Some r%s, o: Some r%s]\n" i.index o.index);
Printf.fprintf ppf "Code:\n";
List.iter (pp_risci ppf) t.code
end
@ -225,7 +229,7 @@ let rec helper
in
match nextnodes with
| Some (nextnode1, None) ->
let res, vis = (helper prg nextnode1) (currentnode :: alreadyVisited) in
let res, vis = (helper prg nextnode1 (currentnode :: alreadyVisited)) in
(currentcode @ res, vis)
| Some (nextnode1, Some nextnode2) -> (
let ncs = nextCommonSuccessor prg nextnode1 nextnode2 in
@ -248,6 +252,7 @@ let rec helper
| BImmOp (_, _, _, r)
| URegOp (_, _, r)
| Load (_, r)
| Store (r, _)
| LoadI (_, r) -> (([Label label1] : RISCAssembly.risci list) @
currentcode @
([CJump (r, label2, label3); Label label2] : RISCAssembly.risci list) @
@ -269,6 +274,7 @@ let rec helper
| BImmOp (_, _, _, r)
| URegOp (_, _, r)
| Load (_, r)
| Store (r, _)
| LoadI (_, r) -> (currentcode @
([CJump (r, label1, label2); Label label1] : RISCAssembly.risci list) @
res1 @

53
lib/miniImp/reduceRegisters.ml
View File

@ -20,7 +20,7 @@ module VariableMap = Map.Make(Variable)
let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
let add_one = (fun x -> match x with None -> Some 1 | Some x -> Some (x + 1)) in
let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) =
let helper (acc: int VariableMap.t) (instr: RISCCfg.elt) : int VariableMap.t =
match instr with
| Nop ->
acc
@ -41,9 +41,12 @@ let variables_frequency (instr : RISCCfg.elt) : (Variable.t * int) list =
helper VariableMap.empty instr |> VariableMap.to_list
let variables_all_frequency (instructions : RISCCfg.elt list) : (Variable.t * int) list =
List.fold_left (fun (acc: int VariableMap.t) (instr: RISCCfg.elt) ->
VariableMap.union (fun _v x y -> Some (x + y)) acc (variables_frequency instr |> VariableMap.of_list)
) VariableMap.empty instructions |> VariableMap.to_list
List.fold_left
( fun (acc: int VariableMap.t) (instr: RISCCfg.elt) ->
VariableMap.union
(fun _v x y -> Some (x + y))
acc (variables_frequency instr |> VariableMap.of_list) )
VariableMap.empty instructions |> VariableMap.to_list
let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
@ -52,10 +55,11 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
(* we get all the variables with associated frequency (only syntactic use) *)
let all_variables = List.fold_left
(fun acc (_, code) ->
Utility.unique_union acc (variables_all_frequency code))
Utility.unique_union_assoc (fun _n x y -> x + y) acc (variables_all_frequency code))
[]
(Cfg.NodeMap.to_list cfg.content)
in
let all_variables =
match cfg.inputOutputVar with
| None -> all_variables
@ -65,6 +69,7 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
| Some f -> (i, f+1) :: (List.remove_assoc i all_variables)
)
in
let all_variables =
match cfg.inputOutputVar with
| None -> all_variables
@ -95,15 +100,11 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
VariableMap.find_opt r2.index remappedregisters,
VariableMap.find_opt r3.index remappedregisters,
VariableMap.find_opt r1.index memorymap,
VariableMap.find_opt r1.index memorymap,
VariableMap.find_opt r2.index memorymap,
VariableMap.find_opt r3.index memorymap )
with
| Some r1, Some r2, Some r3, _, _, _ ->
[BRegOp (brop, {index = r1}, {index = r2}, {index = r3})]
| Some r1, Some r2, None, _, _, Some m3 ->
[BRegOp (brop, {index = r1}, {index = r2}, tmpreg2);
LoadI (m3, tmpreg1);
Store (tmpreg2, tmpreg1)]
| Some r1, None, Some r3, _, Some m2, _ ->
[LoadI (m2, tmpreg2);
Load (tmpreg2, tmpreg2);
@ -118,6 +119,22 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
LoadI (m2, tmpreg2);
Load (tmpreg2, tmpreg2);
BRegOp (brop, tmpreg1, tmpreg2, {index = r3})]
| Some r1, Some r2, None, _, _, Some m3 ->
[BRegOp (brop, {index = r1}, {index = r2}, tmpreg2);
LoadI (m3, tmpreg1);
Store (tmpreg2, tmpreg1)]
| Some r1, None, None, _, Some m2, Some m3 ->
[LoadI (m2, tmpreg2);
Load (tmpreg2, tmpreg2);
BRegOp (brop, {index = r1}, tmpreg2, tmpreg2);
LoadI (m3, tmpreg1);
Store (tmpreg2, tmpreg1)]
| None, Some r2, None, Some m1, _, Some m3 ->
[LoadI (m1, tmpreg1);
Load (tmpreg1, tmpreg1);
BRegOp (brop, tmpreg1, {index = r2}, tmpreg2);
LoadI (m3, tmpreg1);
Store (tmpreg2, tmpreg1)]
| None, None, None, Some m1, Some m2, Some m3 ->
[LoadI (m1, tmpreg1);
Load (tmpreg1, tmpreg1);
@ -248,16 +265,11 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
)
in
List.map (fun x ->
Printf.printf "Converting: %a\n" CfgRISC.RISCSimpleStatements.pp x;
let tmp = aux x in
Printf.printf "Into: %a\n\n" CfgRISC.RISCSimpleStatements.pplist tmp;
tmp
) code |> List.concat
List.map aux code |> List.concat
in
let aux (cfg: RISCCfg.t) all_variables =
let aux (cfg: RISCCfg.t) (all_variables: (string * int) list) =
(* we keep the first two variables free for immediate use *)
let most_frequent, least_frequent =
List.sort (fun (_a, fa) (_b, fb) -> Int.compare fb fa) all_variables
@ -279,11 +291,6 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
|> VariableMap.of_list
in
Printf.printf "Most freq mapping:\n";
List.iter (fun (a, b) -> Printf.printf "%s -> %s\n" a b) (VariableMap.to_list most_frequent_mapping);
Printf.printf "Least freq mapping:\n";
List.iter (fun (a, b) -> Printf.printf "%s -> mem %d\n" a b) (VariableMap.to_list least_frequent_mapping);
(* we need to replace both at the same time, because we might have mapped
some registers to already used registers, so a double pass might not
differentiate the two *)
@ -411,6 +418,6 @@ let reduceregisters (n: int) (cfg: RISCCfg.t) : RISCCfg.t =
in
( if List.length all_variables < n
( if List.length all_variables <= n
then cfg
else aux cfg all_variables )

98
lib/utility/utility.ml
View File

@ -41,15 +41,15 @@ let int_not a =
if a > 0 then 0 else 1
(* converts an integer to a list of chars such that it is pretty and linear *)
let rec fromIntToString (alphabet: string) (x: int) : string =
let base = String.length alphabet in
if x < 0 then
""
else if x < base then
String.get alphabet x |> String.make 1
else
(fromIntToString (alphabet) (x/base - 1)) ^ (String.get alphabet (x mod base)
|> String.make 1)
(* let rec fromIntToString (alphabet: string) (x: int) : string = *)
(* let base = String.length alphabet in *)
(* if x < 0 then *)
(* "" *)
(* else if x < base then *)
(* String.get alphabet x |> String.make 1 *)
(* else *)
(* (fromIntToString (alphabet) (x/base - 1)) ^ (String.get alphabet (x mod base) *)
(* |> String.make 1) *)
(* true if every element of la is in lb *)
@ -93,7 +93,7 @@ let unique l =
(* returns the unique elements of the concat of the lists *)
let unique_union la lb =
unique (la @ lb)
la @ lb |> unique
(* returns all elements both in la and in lb *)
let unique_intersection la lb =
@ -107,6 +107,24 @@ let unique_intersection la lb =
in
aux la [] |> unique
(* given two lists of associations combines them and if an item is the same,
a provided function is applied to the associated values to create the new
association *)
let unique_union_assoc f l1 l2 =
let rec aux l acc =
match l with
| [] ->
acc
| (h1, h2) :: t ->
( match List.find_opt (fun (a, _) -> a = h1) acc with
| None -> aux t ((h1, h2) :: acc)
| Some (_h1, h3) -> aux
t
((h1, f h1 h2 h3) :: (List.remove_assoc h1 acc)) )
in
aux l2 (aux l1 [])
(* returns a list with at most n items and the rest in the second *)
let rec take (n: int) (l: 'a list) : ('a list * 'a list) =
match n with
@ -118,73 +136,27 @@ let rec take (n: int) (l: 'a list) : ('a list * 'a list) =
let (t1, t2) = (take (n - 1) ls) in
((i :: t1), (t2))
(* returns the list without the last element *)
let drop_last_element_list =
function
| [] -> []
| l -> l |> List.rev |> List.tl |> List.rev
(* takes a list and returns the same list without the first element;
different from List.tl since returns the empty list if there are not enough
items*)
let drop_first_element_list =
function
| [] -> []
| _::l -> l
(* Complicated way to drop the last element and add a new option element to the
beginning *)
let prev l a =
match l with
| [] ->
[a]
| _ ->
a :: (List.map (fun x -> Some x) (drop_last_element_list l))
let pad l a n =
let l = List.map (fun i -> Some i) l in
if List.length l < n
then
l @ (List.init (n - List.length l) (fun _ -> a))
else
l
let pad_opt l a n =
if List.length l < n
then
l @ (List.init (n - List.length l) (fun _ -> a))
else
l
let combine la lb =
List.map2 (fun a b ->
match b with
None -> None
| Some b -> Some (a, b)
) la lb
(* retuns the last element of a list *)
let rec last_list l =
match l with
[] -> failwith "Utility.last_list, not enough items"
| [a] -> a
| _::ll -> last_list ll
let add_to_last_list (la: 'a list list) (a: 'a) : 'a list list =
let rec aux la a =
match la with
[] -> [[a]]
| [l] -> [a :: l]
| l::la -> l :: (aux la a)
in
aux la a
(* combines two lists into a list of tuples; different from List.combine since
lengths do not need to be equal, the functions return a list with length
equal to the minimum of the input lists *)
let rec combine_twice la lb =
match (la, lb) with
| [], [] -> []
| [a], [b] -> [a, b]
| a::la, b::lb -> (a, b) :: (combine_twice la lb)
| _ -> []
let rec combine_thrice la lb lc =
match (la, lb, lc) with
| [], [], [] -> []
| [a], [b], [c] -> [a, b, c]
| a::la, b::lb, c::lc -> (a, b, c) :: (combine_thrice la lb lc)
| _ -> []

12
lib/utility/utility.mli
View File

@ -10,28 +10,20 @@ val int_more : int -> int -> int
val int_more_eq : int -> int -> int
val int_not : int -> int
val fromIntToString : string -> int -> string
(* val fromIntToString : string -> int -> string *)
val inclusion : 'a list -> 'a list -> bool
val equality : 'a list -> 'a list -> bool
val subtraction : 'a list -> 'a list -> 'a list
val unique : 'a list -> 'a list
val unique_union : 'a list -> 'a list -> 'a list
val unique_intersection : 'a list -> 'a list -> 'a list
val unique_union_assoc : ('a -> 'b -> 'b -> 'b) -> ('a * 'b) list -> ('a * 'b) list -> ('a * 'b) list
val take : int -> 'a list -> ('a list * 'a list)
val drop_last_element_list : 'a list -> 'a list
val drop_first_element_list : 'a list -> 'a list
val prev : 'a list -> 'a option -> 'a option list
val pad : 'a list -> 'a option -> int -> 'a option list
val pad_opt : 'a option list -> 'a option -> int -> 'a option list
val combine : 'a list -> 'b option list -> ('a * 'b) option list
val last_list : 'a list -> 'a
val add_to_last_list : 'a list list -> 'a -> 'a list list
val combine_twice : 'a list -> 'b list -> ('a * 'b) list
val combine_thrice : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list