Commit 4b249c26 authored by Armillon Damien's avatar Armillon Damien
Browse files

Finish pointers

parent aba710e2
......@@ -10,6 +10,8 @@ type expr =
| Eint of int
| Evar of string
| Ecall of string * expr list
| Estk of int
| Eload of expr * int
type cfg_node =
| Cassign of string * expr * int
......@@ -18,11 +20,13 @@ type cfg_node =
| Ccmp of expr * int * int
| Cnop of int
| Ccall of string * expr list * int
| Cstore of expr * expr * int * int
type cfg_fun = {
cfgfunargs: string list;
cfgfunbody: (int, cfg_node) Hashtbl.t;
cfgentry: int;
cfgfunstksz: int;
}
type cprog = cfg_fun prog
......@@ -34,11 +38,12 @@ let succs cfg n =
match Hashtbl.find_option cfg n with
| None -> Set.empty
| Some (Cprint (_, s))
| Some (Cnop s)
| Some (Ccall (_,_,s))
| Some (Cstore (_,_,_,s))
| Some (Cassign (_, _, s)) -> Set.singleton s
| Some (Creturn _) -> Set.empty
| Some (Ccmp (_, s1, s2)) -> Set.of_list [s1;s2]
| Some (Cnop s) -> Set.singleton s
| Some (Ccall (_,_,s)) -> Set.singleton s
(* [preds cfg n] donne l'ensemble des prédécesseurs d'un nœud [n] dans un CFG [cfg]
......@@ -49,6 +54,7 @@ let preds cfgfunbody n =
| Cassign (_, _, s)
| Cprint (_, s)
| Ccall (_,_,s)
| Cstore (_,_,_,s)
| Cnop s -> if s = n then Set.add m acc else acc
| Creturn _ -> acc
| Ccmp (_, s1, s2) -> if s1 = n || s2 = n then Set.add m acc else acc
......@@ -67,7 +73,9 @@ let rec size_expr (e: expr) : int =
| Eunop (u, e) -> size_unop u (size_expr e)
| Eint _ -> 1
| Evar v -> 1
| Ecall (n, el) -> 1 + List.fold_left (fun acc e -> acc + (size_expr e)) 0 el
| Ecall (n, el) -> 1 + List.fold_left (fun acc e -> acc + (size_expr e)) 0 el
| Estk _ -> 1
| Eload (e,u) -> 1 + size_expr e
let rec size_instr (i: cfg_node) : int =
match (i : cfg_node) with
......@@ -76,7 +84,8 @@ let rec size_instr (i: cfg_node) : int =
| Cprint (e, s) -> 1 + (size_expr e)
| Ccmp (e, s1, s2) -> 1 + size_expr e
| Cnop s -> 1
| Ccall (n, el, s) -> 1 + List.fold_left (fun acc e -> acc + (size_expr e)) 0 el
| Ccall (n, el, s) -> 1 + List.fold_left (fun acc e -> acc + (size_expr e)) 0 el
| Cstore (e1,e2,_,_) -> 1+ size_expr e1 + size_expr e2
let size_fun f =
Hashtbl.fold (fun k v acc -> acc + size_instr v) f 0
......
......@@ -21,8 +21,10 @@ let rec simple_eval_eexpr (e: expr) : int =
let v1 = simple_eval_eexpr e in
let v = (eval_unop u v1) in
v
| Estk i
| Eint i -> i
| Ecall (name,_) -> failwith (Printf.sprintf "tried to call %s" name)
| Eload (e, _) -> failwith "No load authorized"
| _ -> failwith "unevaluable expr (const propagation)"
......@@ -31,8 +33,10 @@ let rec simple_eval_eexpr (e: expr) : int =
(* [has_vars e] indicates whether [e] contains variables. *)
let rec has_vars (e: expr) =
match e with
| Estk n -> true (*TODO set to false later*)
| Eint(n) -> false
| Evar(str) -> true
| Eload(e',_)
| Eunop(_,e') -> has_vars e'
| Ebinop(_,e',e'') -> has_vars e' || has_vars e''
| Ecall(_,el) -> true
......@@ -68,6 +72,7 @@ let constant_propagation_instr (i: cfg_node) : cfg_node =
| Ccmp(e,n,n') -> Ccmp(const_prop_expr e, n, n')
| Cnop(n) -> Cnop(n)
| Ccall(str, el, n) -> Ccall(str, List.map const_prop_expr el, n)
| Cstore(e1,e2, n, s) -> Cstore(e1, const_prop_expr e2, n, s)
let constant_propagation_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
let ht = Hashtbl.map (fun n m ->
......
......@@ -6,31 +6,69 @@ open Prog
open Report
open Cfg_print
open Options
open Elang_gen
(* [cfg_expr_of_eexpr e] converts an [Elang.expr] into a [expr res]. This should
(* [cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e] converts an [Elang.expr] into a [expr res]. This should
always succeed and be straightforward.
In later versions of this compiler, you will add more things to [Elang.expr]
but not to [Cfg.expr], hence the distinction.
*)
let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
let rec cfg_expr_of_eexpr fun_typ (funvartyp: (string, typ) Hashtbl.t) (funvarinmem: (string, int) Hashtbl.t) (e: Elang.expr) : expr res =
match e with
| Elang.Ebinop (b, e1, e2) ->
cfg_expr_of_eexpr e1 >>= fun ee1 ->
cfg_expr_of_eexpr e2 >>= fun ee2 ->
OK (Ebinop (b, ee1, ee2))
let* t1 = type_expr funvartyp fun_typ e1 in
let* t2 = type_expr funvartyp fun_typ e2 in
let* value1 = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e1 in
let* value2 = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e2 in
(match t1 with
| Tptr t ->
let* size = size_type t in
OK(Ebinop(b, value1, Ebinop(Emul, value2, Eint size)))
| _ ->
(match t2 with
| Tptr t ->
let* size = size_type t in
OK(Ebinop(b, (Ebinop(Emul, value1, Eint size)), value2))
| _ ->
OK (Ebinop (b, value1, value2))
))
| Elang.Eunop (u, e) ->
cfg_expr_of_eexpr e >>= fun ee ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun ee ->
OK (Eunop (u, ee))
| Elang.Eint i -> OK (Eint i)
| Elang.Echar c -> OK (Eint (Char.code c))
| Elang.Evar v ->
OK (Evar v)
(
match Hashtbl.find_option funvarinmem v with
| Some offset ->
let* mem_to_read = size_type (Hashtbl.find funvartyp v) in
OK(Eload(Estk offset,mem_to_read))
| None ->OK (Evar v)
)
| Elang.Ecall(name, elist) ->
let* args_expr = list_map_res (cfg_expr_of_eexpr) elist in
let* args_expr = list_map_res (cfg_expr_of_eexpr fun_typ funvartyp funvarinmem) elist in
OK(Cfg.Ecall(name, args_expr))
| _ -> Error "NO CFG YET"
(* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond
| Elang.Eaddrof (e) ->
(match e with
| Elang.Evar v ->
(match Hashtbl.find_option funvarinmem v with
| Some n -> OK(Estk n)
| None -> Error "& on a variable not in memory (cfg gen)"
)
| _ -> Error "unauthorised operation: & on non var"
)
| Elang.Eload e ->
let* cfg_e = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e in
let* type_to_load = type_expr funvartyp fun_typ e in
(match type_to_load with
| Tptr t ->
let* size = size_type t in
OK(Eload(cfg_e,size))
| _ -> Error "Can't load non pointer")
(* [cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ i] builds the CFG node(s) that correspond
to the E instruction [i].
[cfg] is the current state of the control-flow graph.
......@@ -45,40 +83,56 @@ let rec cfg_expr_of_eexpr (e: Elang.expr) : expr res =
Hint: several nodes may be generated for a single E instruction.
*)
let rec cfg_node_of_einstr (next: int) (cfg : (int, cfg_node) Hashtbl.t)
let rec cfg_node_of_einstr fun_typ funvartyp (funvarinmem: (string, int) Hashtbl.t) (next: int) (cfg : (int, cfg_node) Hashtbl.t)
(succ: int) (i: instr) : (int * int) res =
match i with
| Elang.Iassign (v, e) ->
cfg_expr_of_eexpr e >>= fun e ->
Hashtbl.replace cfg next (Cassign(v,e,succ));
OK (next, next + 1)
let* value = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e in
(match Hashtbl.find_option funvarinmem v with
| Some addr ->
let type_var = Hashtbl.find funvartyp v in
let* size_write = size_type type_var in
Hashtbl.replace cfg next (Cstore(Estk addr,value,size_write, succ));
OK(next, next+1)
| None ->
let* e = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e in
Hashtbl.replace cfg next (Cassign(v,e,succ));
OK (next, next + 1))
| Elang.Iif (c, ithen, ielse) ->
cfg_expr_of_eexpr c >>= fun c ->
cfg_node_of_einstr next cfg succ ithen >>= fun (nthen, next) ->
cfg_node_of_einstr next cfg succ ielse >>= fun (nelse, next) ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem c >>= fun c ->
cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ ithen >>= fun (nthen, next) ->
cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ ielse >>= fun (nelse, next) ->
Hashtbl.replace cfg next (Ccmp(c, nthen, nelse)); OK (next, next + 1)
| Elang.Iwhile (c, i) ->
cfg_expr_of_eexpr c >>= fun c ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem c >>= fun c ->
let (cmp, next) = (next, next + 1) in
cfg_node_of_einstr next cfg cmp i >>= fun (nthen, next) ->
cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg cmp i >>= fun (nthen, next) ->
Hashtbl.replace cfg cmp (Ccmp(c, nthen, succ)); OK (cmp, next + 1)
| Elang.Iblock il ->
List.fold_right (fun i acc ->
acc >>= fun (succ, next) ->
cfg_node_of_einstr next cfg succ i
cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ i
) il (OK (succ, next))
| Elang.Ireturn e ->
cfg_expr_of_eexpr e >>= fun e ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun e ->
Hashtbl.replace cfg next (Creturn e); OK (next, next + 1)
| Elang.Iprint e ->
cfg_expr_of_eexpr e >>= fun e ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun e ->
Hashtbl.replace cfg next (Cprint (e,succ));
OK (next, next + 1)
| Elang.Icall(name, elist) ->
let* args_expr = list_map_res (cfg_expr_of_eexpr) elist in
let* args_expr = list_map_res (cfg_expr_of_eexpr fun_typ funvartyp funvarinmem) elist in
Hashtbl.replace cfg next (Ccall(name, args_expr, succ));
OK (next,next+1)
| _ -> Error "NO CFG YET"
| Elang.Istore (e1, e2) ->
let* addr = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e1 in
let* value = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e2 in
let* t = type_expr funvartyp fun_typ e1 in
let* size_write = size_type t in
Hashtbl.replace cfg next (Cstore(addr,value,size_write, succ));
OK(next, next+1)
......@@ -94,6 +148,7 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
| Some (Cnop succ)
| Some (Cprint (_, succ))
| Some (Ccall(_,_,succ))
| Some (Cstore(_,_,_,succ))
| Some (Cassign (_, _, succ)) -> reachable_aux succ reach
| Some (Creturn _) -> reach
| Some (Ccmp (_, s1, s2)) ->
......@@ -101,24 +156,33 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
in reachable_aux n Set.empty
(* [cfg_fun_of_efun f] builds the CFG for E function [f]. *)
let cfg_fun_of_efun { funargs; funbody } =
let cfg_fun_of_efun fun_typ { funargs; funbody; funvartyp; funvarinmem; funstksz } =
let cfg = Hashtbl.create 17 in
Hashtbl.replace cfg 0 (Creturn (Eint 0));
cfg_node_of_einstr 1 cfg 0 funbody >>= fun (node, _) ->
cfg_node_of_einstr fun_typ funvartyp funvarinmem 1 cfg 0 funbody >>= fun (node, _) ->
(* remove unreachable nodes *)
let r = reachable_nodes node cfg in
Hashtbl.filteri_inplace (fun k _ -> Set.mem k r) cfg;
OK { cfgfunargs = fst (List.split funargs);
cfgfunbody = cfg;
cfgentry = node;
cfgfunstksz = funstksz;
}
let cfg_gdef_of_edef gd =
let cfg_gdef_of_edef fun_typ gd =
match gd with
Gfun f -> cfg_fun_of_efun f >>= fun f -> OK (Gfun f)
Gfun f -> cfg_fun_of_efun fun_typ f >>= fun f -> OK (Gfun f)
let cfg_prog_of_eprog (ep: eprog) : cfg_fun prog res =
assoc_map_res (fun fname -> cfg_gdef_of_edef) ep
let fun_typ = Hashtbl.create (3+(List.length ep)) in
List.iter (fun (name,pro) ->
match pro with
| Gfun f -> Hashtbl.replace fun_typ name ((snd (List.split f.funargs)),f.funrettype);
)ep;
Hashtbl.replace fun_typ "print" ([Tint], Tvoid);
Hashtbl.replace fun_typ "print_int" ([Tint], Tvoid);
Hashtbl.replace fun_typ "print_char" ([Tchar], Tvoid);
assoc_map_res (fun fname -> cfg_gdef_of_edef fun_typ) ep
let pass_cfg_gen ep =
match cfg_prog_of_eprog ep with
......
......@@ -9,23 +9,25 @@ open Utils
let rec vars_in_expr (e: expr) =
match e with
| Evar(str) -> Set.singleton(str)
| Estk i
| Eint(i) -> Set.empty
| Eunop(_,e1) -> vars_in_expr e1
| Ebinop(_,e1,e2) -> Set.union (vars_in_expr e1) (vars_in_expr e2)
| Ecall(_,el) -> List.fold_left (fun acc expr -> Set.union acc (vars_in_expr expr)) Set.empty el
| Eload (e,n) -> vars_in_expr e
(* [live_cfg_node node live_after] renvoie l'ensemble des variables vivantes
(* [live_cfg_node node live_after] renvoie l'ensemble des variables vivantes
avant un nœud [node], étant donné l'ensemble [live_after] des variables
vivantes après ce nœud. *)
let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
match node with
| Cnop(n) -> live_after
| Cassign(str, e,n) -> Set.union (vars_in_expr e) (Set.diff live_after (Set.singleton str))
| Cnop(_) -> live_after
| Cassign(str, e,_) -> Set.union (vars_in_expr e) (Set.diff live_after (Set.singleton str))
| Creturn(e)
| Cprint(e,_)
| Ccmp(e,_,_) -> Set.union (vars_in_expr e) live_after
| Ccall(str, el, n) -> List.fold_left (fun acc expr -> Set.union acc (vars_in_expr expr)) live_after el
| Ccall(_, el, _) -> List.fold_left (fun acc expr -> Set.union acc (vars_in_expr expr)) live_after el
| Cstore(e1, e2,_,_) -> Set.union (Set.union (vars_in_expr e2) (vars_in_expr e1)) live_after
(* [live_after_node cfg n] renvoie l'ensemble des variables vivantes après le
......
......@@ -10,6 +10,8 @@ let rec dump_cfgexpr : expr -> string = function
| Eint i -> Format.sprintf "%d" i
| Evar s -> Format.sprintf "%s" s
| Ecall (name,el) -> Format.sprintf "%s(%s)" name (dump_list_cfgexpr el)
| Estk (i) -> Format.sprintf "addr %d" i
| Eload (e,n) -> Format.sprintf "load (%s) [%d bytes]" (dump_cfgexpr e) n
and dump_list_cfgexpr l =
l |> List.map dump_cfgexpr |> String.concat ", "
......@@ -20,6 +22,7 @@ let dump_arrows oc fname n (node: cfg_node) =
| Cassign (_, _, succ)
| Cprint (_, succ)
| Ccall (_,_,succ)
| Cstore (_,_,_,succ)
| Cnop succ ->
Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ
| Creturn _ -> ()
......@@ -27,7 +30,6 @@ let dump_arrows oc fname n (node: cfg_node) =
Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"then\"]\n" fname n fname succ1;
Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"else\"]\n" fname n fname succ2
let dump_cfg_node oc (node: cfg_node) =
match node with
| Cassign (v, e, _) -> Format.fprintf oc "%s = %s" v (dump_cfgexpr e)
......@@ -36,6 +38,7 @@ let dump_cfg_node oc (node: cfg_node) =
| Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e)
| Cnop _ -> Format.fprintf oc "nop"
| Ccall (n,el,_) -> Format.fprintf oc "%s(%s)" n (dump_list_cfgexpr el)
| Cstore(e1,e2,_,_) -> Format.fprintf oc "%s <- %s" (dump_cfgexpr e1) (dump_cfgexpr e2)
let dump_liveness_state oc ht state =
......
......@@ -7,15 +7,15 @@ open Cfg
open Utils
open Builtins
let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
let rec eval_cfgexpr sp oc cp st (e: expr) : (int * int Prog.state) res =
match e with
| Ebinop(b, e1, e2) ->
let* (v1, st) = eval_cfgexpr oc cp st e1 in
let* (v2, st) = eval_cfgexpr oc cp st e2 in
let* (v1, st) = eval_cfgexpr sp oc cp st e1 in
let* (v2, st) = eval_cfgexpr sp oc cp st e2 in
let v = eval_binop b v1 v2 in
OK (v, st)
| Eunop(u, e) ->
let* (v1,st) = eval_cfgexpr oc cp st e in
let* (v1,st) = eval_cfgexpr sp oc cp st e in
let v = (eval_unop u v1) in
OK (v, st)
| Eint i -> OK (i, st)
......@@ -27,12 +27,12 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
| Ecall(name,el) ->
let* (params, st) = List.fold_left (fun acc expr ->
let* (expr_list,st) = acc in
let* (new_expr, st) = eval_cfgexpr oc cp st expr in
let* (new_expr, st) = eval_cfgexpr sp oc cp st expr in
OK(expr_list@[new_expr], st)
) (OK([],st)) el in
match find_function cp name with
(match find_function cp name with
| OK f ->
let* (i,st) = eval_cfgfun cp oc st name f params in
let* (i,st) = eval_cfgfun (sp + f.cfgfunstksz) cp oc st name f params in
(match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st))
......@@ -40,48 +40,53 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
let* ret = do_builtin oc st.mem name params in
(match ret with
| Some n -> OK(n, st)
| None -> OK(0, st))
| None -> OK(0, st)))
| Estk i ->Printf.printf "Addres %d + %d\n" i sp; OK(i+sp, st)
| Eload (e,size) ->
let* (addr,st) = eval_cfgexpr sp oc cp st e in
Printf.printf "On lit à %d\n" addr;
let* value = Mem.read_bytes_as_int st.mem addr size in
OK(value, st)
and eval_cfginstr cp oc st ht (n: int): (int * int state) res =
and eval_cfginstr sp cp oc st ht (n: int): (int * int state) res =
match Hashtbl.find_option ht n with
| None -> Error (Printf.sprintf "Invalid node identifier\n")
| Some node ->
match node with
| Cnop succ ->
eval_cfginstr cp oc st ht succ
eval_cfginstr sp cp oc st ht succ
| Cassign(v, e, succ) ->
let* (i, st) = eval_cfgexpr oc cp st e in
let* (i, st) = eval_cfgexpr sp oc cp st e in
Hashtbl.replace st.env v i;
eval_cfginstr cp oc st ht succ
eval_cfginstr sp cp oc st ht succ
| Ccmp(cond, i1, i2) ->
let* (i,st) = eval_cfgexpr oc cp st cond in
if i = 0 then eval_cfginstr cp oc st ht i2 else eval_cfginstr cp oc st ht i1
let* (i,st) = eval_cfgexpr sp oc cp st cond in
if i = 0 then eval_cfginstr sp cp oc st ht i2 else eval_cfginstr sp cp oc st ht i1
| Creturn(e) ->
let* (e,st) = eval_cfgexpr oc cp st e in
let* (e,st) = eval_cfgexpr sp oc cp st e in
OK (e, st)
| Cprint(e, succ) ->
let* (e, st) = eval_cfgexpr oc cp st e in
let* (e, st) = eval_cfgexpr sp oc cp st e in
Format.fprintf oc "%d\n" e;
eval_cfginstr cp oc st ht succ
eval_cfginstr sp cp oc st ht succ
| Ccall(name, el, succ) ->
let* (params, st) = List.fold_left (fun acc expr ->
let* (expr_list,st) = acc in
let* (new_expr, st) = eval_cfgexpr oc cp st expr in
let* (new_expr, st) = eval_cfgexpr sp oc cp st expr in
OK(expr_list@[new_expr], st)
) (OK([],st)) el in
match find_function cp name with
(match find_function cp name with
| OK f ->
let* f = find_function cp name in
let* (i,st) = eval_cfgfun cp oc st name f params in
let* (i,st) = eval_cfgfun (sp + f.cfgfunstksz) cp oc st name f params in
(match i with
| None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st))
| Some(i) -> eval_cfginstr sp cp oc st ht succ)
| Error _ ->
match find_function cp name with
(match find_function cp name with
| OK f ->
let* (res,st) = eval_cfgfun cp oc st name f params in
let* (res,st) = eval_cfgfun (sp+f.cfgfunstksz) cp oc st name f params in
(match res with
| Some(n) -> OK(n, st)
| None -> Error (Format.sprintf "Error with function %s" name))
......@@ -89,16 +94,25 @@ and eval_cfginstr cp oc st ht (n: int): (int * int state) res =
let* ret = do_builtin oc st.mem name params in
(match ret with
| Some n -> OK(n, st)
| None -> eval_cfginstr cp oc st ht succ)
| None -> eval_cfginstr sp cp oc st ht succ)))
| Cstore (e1,e2,size,succ) ->
let* (addr,st) = eval_cfgexpr sp oc cp st e1 in
let* (value,st) = eval_cfgexpr sp oc cp st e2 in
Printf.printf "We write %d in %d\n" value addr;
let bytes_to_write = split_bytes (size) value in
let* _ = Mem.write_bytes st.mem addr bytes_to_write in
eval_cfginstr sp cp oc st ht succ
and eval_cfgfun cp oc st cfgfunname { cfgfunargs;
and eval_cfgfun sp cp oc st cfgfunname { cfgfunargs;
cfgfunbody;
cfgentry} vargs =
let st' = { st with env = Hashtbl.create 17 } in
match List.iter2 (fun a v -> Hashtbl.replace st'.env a v) cfgfunargs vargs with
| () -> eval_cfginstr cp oc st' cfgfunbody cfgentry >>= fun (v, st') ->
| () -> eval_cfginstr sp cp oc st' cfgfunbody cfgentry >>= fun (v, st') ->
OK (Some v, {st' with env = st.env})
| exception Invalid_argument _ ->
Error (Format.sprintf "CFG: Called function %s with %d arguments, expected %d.\n"
......@@ -110,7 +124,7 @@ let eval_cfgprog oc cp memsize params =
find_function cp "main" >>= fun f ->
let n = List.length f.cfgfunargs in
let params = take n params in
eval_cfgfun cp oc st "main" f params >>= fun (v, st) ->
eval_cfgfun 0 cp oc st "main" f params >>= fun (v, st) ->
OK v
......@@ -87,8 +87,8 @@ let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (in
| Some n -> OK(n, st)
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)))
| Eload e ->
let* type_to_load = type_expr func_env.funvartyp fun_typ e in
let* (addr,st) = eval_eexpr fun_typ oc ep st sp func_env e in
let* type_to_load = type_expr func_env.funvartyp fun_typ e in
(match type_to_load with
| Tptr t ->
let* size = size_type t in
......@@ -179,7 +179,6 @@ and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: i
OK (ret, st))
| Istore(e1, e2) ->
let* (addr,st) = eval_eexpr fun_typ oc ep st sp func_env e1 in
Printf.printf "ICI: %d\n" sp;
let* (value,st) = eval_eexpr fun_typ oc ep st sp func_env e2 in
let* t = type_expr func_env.funvartyp fun_typ e1 in
let* size_write = size_type t in
......
......@@ -8,4 +8,5 @@ type linear_fun = {
linearfunargs: reg list;
linearfunbody: rtl_instr list;
linearfuninfo: (string*reg) list;
linearfunstksz: int;
}
......@@ -14,12 +14,12 @@ let dse_instr (ins: rtl_instr) live =
[ins]
let dse_fun live {linearfunargs; linearfunbody; linearfuninfo; } =
let dse_fun live {linearfunargs; linearfunbody; linearfuninfo; linearfunstksz } =
let body =
linearfunbody
|> List.mapi (fun i ins -> dse_instr ins (Hashtbl.find_default live i Set.empty))
|> List.concat in
{ linearfunargs; linearfunbody = body; linearfuninfo; }
{ linearfunargs; linearfunbody = body; linearfuninfo; linearfunstksz}
let dse_prog p live =
......
......@@ -60,7 +60,7 @@ let remove_useless_labels (l: rtl_instr list) =
) l
let linear_of_rtl_fun
({ rtlfunargs; rtlfunbody; rtlfunentry; rtlfuninfo }: rtl_fun) =
({ rtlfunargs; rtlfunbody; rtlfunentry; rtlfuninfo; rtlfunstksz }: rtl_fun) =
let block_order = sort_blocks rtlfunbody rtlfunentry in
let linearinstrs =
Rjmp rtlfunentry ::
......@@ -73,6 +73,7 @@ let linear_of_rtl_fun
linearfunbody =
linearinstrs |> remove_useless_jumps |> remove_useless_labels;
linearfuninfo = rtlfuninfo;
linearfunstksz = rtlfunstksz;
}
let linear_of_rtl_gdef = function
......
......@@ -7,16 +7,20 @@ open Rtl
let gen_live (i: rtl_instr) =
match i with
| Rbinop (b, rd, rs1, rs2) -> Set.of_list [rs1; rs2]
| Rprint rs
| Runop (_, _, rs) -> Set.singleton rs
| Rconst (_, _) -> Set.empty
| Rbinop (_, _, rs1, rs2)
| Rbranch (_, rs1, rs2, _) -> Set.of_list [rs1; rs2]
| Rjmp _ -> Set.empty
| Rprint rs
| Runop (_, _, rs)
| Rload (_,rs,_)
| Rmov (_, rs) -> Set.singleton rs
| Rret r -> Set.singleton r
| Rlabel _ -> Set.empty
| Rcall (_,_,rl) -> Set.of_list rl
| Rstk(_,_)
| Rstore (_,_,_)
| Rlabel _
| Rjmp _
| Rconst (_, _) -> Set.empty
let kill_live (i: rtl_instr) =
match i with
......@@ -24,11 +28,14 @@ let kill_live (i: rtl_instr) =