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

Finish pointers

parent aba710e2
...@@ -10,6 +10,8 @@ type expr = ...@@ -10,6 +10,8 @@ type expr =
| Eint of int | Eint of int
| Evar of string | Evar of string
| Ecall of string * expr list | Ecall of string * expr list
| Estk of int
| Eload of expr * int
type cfg_node = type cfg_node =
| Cassign of string * expr * int | Cassign of string * expr * int
...@@ -18,11 +20,13 @@ type cfg_node = ...@@ -18,11 +20,13 @@ type cfg_node =
| Ccmp of expr * int * int | Ccmp of expr * int * int
| Cnop of int | Cnop of int
| Ccall of string * expr list * int | Ccall of string * expr list * int
| Cstore of expr * expr * int * int
type cfg_fun = { type cfg_fun = {
cfgfunargs: string list; cfgfunargs: string list;
cfgfunbody: (int, cfg_node) Hashtbl.t; cfgfunbody: (int, cfg_node) Hashtbl.t;
cfgentry: int; cfgentry: int;
cfgfunstksz: int;
} }
type cprog = cfg_fun prog type cprog = cfg_fun prog
...@@ -34,11 +38,12 @@ let succs cfg n = ...@@ -34,11 +38,12 @@ let succs cfg n =
match Hashtbl.find_option cfg n with match Hashtbl.find_option cfg n with
| None -> Set.empty | None -> Set.empty
| Some (Cprint (_, s)) | Some (Cprint (_, s))
| Some (Cnop s)
| Some (Ccall (_,_,s))
| Some (Cstore (_,_,_,s))
| Some (Cassign (_, _, s)) -> Set.singleton s | Some (Cassign (_, _, s)) -> Set.singleton s
| Some (Creturn _) -> Set.empty | Some (Creturn _) -> Set.empty
| Some (Ccmp (_, s1, s2)) -> Set.of_list [s1;s2] | 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] (* [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 = ...@@ -49,6 +54,7 @@ let preds cfgfunbody n =
| Cassign (_, _, s) | Cassign (_, _, s)
| Cprint (_, s) | Cprint (_, s)
| Ccall (_,_,s) | Ccall (_,_,s)
| Cstore (_,_,_,s)
| Cnop s -> if s = n then Set.add m acc else acc | Cnop s -> if s = n then Set.add m acc else acc
| Creturn _ -> acc | Creturn _ -> acc
| Ccmp (_, s1, s2) -> if s1 = n || s2 = n then Set.add m acc else 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 = ...@@ -67,7 +73,9 @@ let rec size_expr (e: expr) : int =
| Eunop (u, e) -> size_unop u (size_expr e) | Eunop (u, e) -> size_unop u (size_expr e)
| Eint _ -> 1 | Eint _ -> 1
| Evar v -> 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 = let rec size_instr (i: cfg_node) : int =
match (i : cfg_node) with match (i : cfg_node) with
...@@ -76,7 +84,8 @@ let rec size_instr (i: cfg_node) : int = ...@@ -76,7 +84,8 @@ let rec size_instr (i: cfg_node) : int =
| Cprint (e, s) -> 1 + (size_expr e) | Cprint (e, s) -> 1 + (size_expr e)
| Ccmp (e, s1, s2) -> 1 + size_expr e | Ccmp (e, s1, s2) -> 1 + size_expr e
| Cnop s -> 1 | 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 = let size_fun f =
Hashtbl.fold (fun k v acc -> acc + size_instr v) f 0 Hashtbl.fold (fun k v acc -> acc + size_instr v) f 0
......
...@@ -21,8 +21,10 @@ let rec simple_eval_eexpr (e: expr) : int = ...@@ -21,8 +21,10 @@ let rec simple_eval_eexpr (e: expr) : int =
let v1 = simple_eval_eexpr e in let v1 = simple_eval_eexpr e in
let v = (eval_unop u v1) in let v = (eval_unop u v1) in
v v
| Estk i
| Eint i -> i | Eint i -> i
| Ecall (name,_) -> failwith (Printf.sprintf "tried to call %s" name) | Ecall (name,_) -> failwith (Printf.sprintf "tried to call %s" name)
| Eload (e, _) -> failwith "No load authorized"
| _ -> failwith "unevaluable expr (const propagation)" | _ -> failwith "unevaluable expr (const propagation)"
...@@ -31,8 +33,10 @@ let rec simple_eval_eexpr (e: expr) : int = ...@@ -31,8 +33,10 @@ let rec simple_eval_eexpr (e: expr) : int =
(* [has_vars e] indicates whether [e] contains variables. *) (* [has_vars e] indicates whether [e] contains variables. *)
let rec has_vars (e: expr) = let rec has_vars (e: expr) =
match e with match e with
| Estk n -> true (*TODO set to false later*)
| Eint(n) -> false | Eint(n) -> false
| Evar(str) -> true | Evar(str) -> true
| Eload(e',_)
| Eunop(_,e') -> has_vars e' | Eunop(_,e') -> has_vars e'
| Ebinop(_,e',e'') -> has_vars e' || has_vars e'' | Ebinop(_,e',e'') -> has_vars e' || has_vars e''
| Ecall(_,el) -> true | Ecall(_,el) -> true
...@@ -68,6 +72,7 @@ let constant_propagation_instr (i: cfg_node) : cfg_node = ...@@ -68,6 +72,7 @@ let constant_propagation_instr (i: cfg_node) : cfg_node =
| Ccmp(e,n,n') -> Ccmp(const_prop_expr e, n, n') | Ccmp(e,n,n') -> Ccmp(const_prop_expr e, n, n')
| Cnop(n) -> Cnop(n) | Cnop(n) -> Cnop(n)
| Ccall(str, el, n) -> Ccall(str, List.map const_prop_expr el, 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 constant_propagation_fun ({ cfgfunargs; cfgfunbody; cfgentry } as f: cfg_fun) =
let ht = Hashtbl.map (fun n m -> let ht = Hashtbl.map (fun n m ->
......
...@@ -6,31 +6,69 @@ open Prog ...@@ -6,31 +6,69 @@ open Prog
open Report open Report
open Cfg_print open Cfg_print
open Options 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. always succeed and be straightforward.
In later versions of this compiler, you will add more things to [Elang.expr] In later versions of this compiler, you will add more things to [Elang.expr]
but not to [Cfg.expr], hence the distinction. 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 match e with
| Elang.Ebinop (b, e1, e2) -> | Elang.Ebinop (b, e1, e2) ->
cfg_expr_of_eexpr e1 >>= fun ee1 -> let* t1 = type_expr funvartyp fun_typ e1 in
cfg_expr_of_eexpr e2 >>= fun ee2 -> let* t2 = type_expr funvartyp fun_typ e2 in
OK (Ebinop (b, ee1, ee2)) 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) -> | 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)) OK (Eunop (u, ee))
| Elang.Eint i -> OK (Eint i) | Elang.Eint i -> OK (Eint i)
| Elang.Echar c -> OK (Eint (Char.code c)) | Elang.Echar c -> OK (Eint (Char.code c))
| Elang.Evar v -> | 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) -> | 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)) OK(Cfg.Ecall(name, args_expr))
| _ -> Error "NO CFG YET" | Elang.Eaddrof (e) ->
(* [cfg_node_of_einstr next cfg succ i] builds the CFG node(s) that correspond (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]. to the E instruction [i].
[cfg] is the current state of the control-flow graph. [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 = ...@@ -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. 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 = (succ: int) (i: instr) : (int * int) res =
match i with match i with
| Elang.Iassign (v, e) -> | Elang.Iassign (v, e) ->
cfg_expr_of_eexpr e >>= fun e -> let* value = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e in
Hashtbl.replace cfg next (Cassign(v,e,succ)); (match Hashtbl.find_option funvarinmem v with
OK (next, next + 1) | 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) -> | Elang.Iif (c, ithen, ielse) ->
cfg_expr_of_eexpr c >>= fun c -> cfg_expr_of_eexpr fun_typ funvartyp funvarinmem c >>= fun c ->
cfg_node_of_einstr next cfg succ ithen >>= fun (nthen, next) -> cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ ithen >>= fun (nthen, next) ->
cfg_node_of_einstr next cfg succ ielse >>= fun (nelse, 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) Hashtbl.replace cfg next (Ccmp(c, nthen, nelse)); OK (next, next + 1)
| Elang.Iwhile (c, i) -> | 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 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) Hashtbl.replace cfg cmp (Ccmp(c, nthen, succ)); OK (cmp, next + 1)
| Elang.Iblock il -> | Elang.Iblock il ->
List.fold_right (fun i acc -> List.fold_right (fun i acc ->
acc >>= fun (succ, next) -> 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)) ) il (OK (succ, next))
| Elang.Ireturn e -> | 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) Hashtbl.replace cfg next (Creturn e); OK (next, next + 1)
| Elang.Iprint e -> | 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)); Hashtbl.replace cfg next (Cprint (e,succ));
OK (next, next + 1) OK (next, next + 1)
| Elang.Icall(name, elist) -> | 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)); Hashtbl.replace cfg next (Ccall(name, args_expr, succ));
OK (next,next+1) 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) = ...@@ -94,6 +148,7 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
| Some (Cnop succ) | Some (Cnop succ)
| Some (Cprint (_, succ)) | Some (Cprint (_, succ))
| Some (Ccall(_,_,succ)) | Some (Ccall(_,_,succ))
| Some (Cstore(_,_,_,succ))
| Some (Cassign (_, _, succ)) -> reachable_aux succ reach | Some (Cassign (_, _, succ)) -> reachable_aux succ reach
| Some (Creturn _) -> reach | Some (Creturn _) -> reach
| Some (Ccmp (_, s1, s2)) -> | Some (Ccmp (_, s1, s2)) ->
...@@ -101,24 +156,33 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) = ...@@ -101,24 +156,33 @@ let rec reachable_nodes n (cfg: (int,cfg_node) Hashtbl.t) =
in reachable_aux n Set.empty in reachable_aux n Set.empty
(* [cfg_fun_of_efun f] builds the CFG for E function [f]. *) (* [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 let cfg = Hashtbl.create 17 in
Hashtbl.replace cfg 0 (Creturn (Eint 0)); 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 *) (* remove unreachable nodes *)
let r = reachable_nodes node cfg in let r = reachable_nodes node cfg in
Hashtbl.filteri_inplace (fun k _ -> Set.mem k r) cfg; Hashtbl.filteri_inplace (fun k _ -> Set.mem k r) cfg;
OK { cfgfunargs = fst (List.split funargs); OK { cfgfunargs = fst (List.split funargs);
cfgfunbody = cfg; cfgfunbody = cfg;
cfgentry = node; cfgentry = node;
cfgfunstksz = funstksz;
} }
let cfg_gdef_of_edef gd = let cfg_gdef_of_edef fun_typ gd =
match gd with 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 = 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 = let pass_cfg_gen ep =
match cfg_prog_of_eprog ep with match cfg_prog_of_eprog ep with
......
...@@ -9,23 +9,25 @@ open Utils ...@@ -9,23 +9,25 @@ open Utils
let rec vars_in_expr (e: expr) = let rec vars_in_expr (e: expr) =
match e with match e with
| Evar(str) -> Set.singleton(str) | Evar(str) -> Set.singleton(str)
| Estk i
| Eint(i) -> Set.empty | Eint(i) -> Set.empty
| Eunop(_,e1) -> vars_in_expr e1 | Eunop(_,e1) -> vars_in_expr e1
| Ebinop(_,e1,e2) -> Set.union (vars_in_expr e1) (vars_in_expr e2) | 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 | 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 avant un nœud [node], étant donné l'ensemble [live_after] des variables
vivantes après ce nœud. *) vivantes après ce nœud. *)
let live_cfg_node (node: cfg_node) (live_after: string Set.t) = let live_cfg_node (node: cfg_node) (live_after: string Set.t) =
match node with match node with
| Cnop(n) -> live_after | Cnop(_) -> live_after
| Cassign(str, e,n) -> Set.union (vars_in_expr e) (Set.diff live_after (Set.singleton str)) | Cassign(str, e,_) -> Set.union (vars_in_expr e) (Set.diff live_after (Set.singleton str))
| Creturn(e) | Creturn(e)
| Cprint(e,_) | Cprint(e,_)
| Ccmp(e,_,_) -> Set.union (vars_in_expr e) live_after | 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 (* [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 ...@@ -10,6 +10,8 @@ let rec dump_cfgexpr : expr -> string = function
| Eint i -> Format.sprintf "%d" i | Eint i -> Format.sprintf "%d" i
| Evar s -> Format.sprintf "%s" s | Evar s -> Format.sprintf "%s" s
| Ecall (name,el) -> Format.sprintf "%s(%s)" name (dump_list_cfgexpr el) | 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 = and dump_list_cfgexpr l =
l |> List.map dump_cfgexpr |> String.concat ", " l |> List.map dump_cfgexpr |> String.concat ", "
...@@ -20,6 +22,7 @@ let dump_arrows oc fname n (node: cfg_node) = ...@@ -20,6 +22,7 @@ let dump_arrows oc fname n (node: cfg_node) =
| Cassign (_, _, succ) | Cassign (_, _, succ)
| Cprint (_, succ) | Cprint (_, succ)
| Ccall (_,_,succ) | Ccall (_,_,succ)
| Cstore (_,_,_,succ)
| Cnop succ -> | Cnop succ ->
Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ Format.fprintf oc "n_%s_%d -> n_%s_%d\n" fname n fname succ
| Creturn _ -> () | Creturn _ -> ()
...@@ -27,7 +30,6 @@ let dump_arrows oc fname n (node: cfg_node) = ...@@ -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=\"then\"]\n" fname n fname succ1;
Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"else\"]\n" fname n fname succ2 Format.fprintf oc "n_%s_%d -> n_%s_%d [label=\"else\"]\n" fname n fname succ2
let dump_cfg_node oc (node: cfg_node) = let dump_cfg_node oc (node: cfg_node) =
match node with match node with
| Cassign (v, e, _) -> Format.fprintf oc "%s = %s" v (dump_cfgexpr e) | Cassign (v, e, _) -> Format.fprintf oc "%s = %s" v (dump_cfgexpr e)
...@@ -36,6 +38,7 @@ let dump_cfg_node oc (node: cfg_node) = ...@@ -36,6 +38,7 @@ let dump_cfg_node oc (node: cfg_node) =
| Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e) | Ccmp (e, _, _) -> Format.fprintf oc "%s" (dump_cfgexpr e)
| Cnop _ -> Format.fprintf oc "nop" | Cnop _ -> Format.fprintf oc "nop"
| Ccall (n,el,_) -> Format.fprintf oc "%s(%s)" n (dump_list_cfgexpr el) | 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 = let dump_liveness_state oc ht state =
......
...@@ -7,15 +7,15 @@ open Cfg ...@@ -7,15 +7,15 @@ open Cfg
open Utils open Utils
open Builtins 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 match e with
| Ebinop(b, e1, e2) -> | Ebinop(b, e1, e2) ->
let* (v1, st) = eval_cfgexpr oc cp st e1 in let* (v1, st) = eval_cfgexpr sp oc cp st e1 in
let* (v2, st) = eval_cfgexpr oc cp st e2 in let* (v2, st) = eval_cfgexpr sp oc cp st e2 in
let v = eval_binop b v1 v2 in let v = eval_binop b v1 v2 in
OK (v, st) OK (v, st)
| Eunop(u, e) -> | 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 let v = (eval_unop u v1) in
OK (v, st) OK (v, st)
| Eint i -> OK (i, st) | Eint i -> OK (i, st)
...@@ -27,12 +27,12 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res = ...@@ -27,12 +27,12 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res =
| Ecall(name,el) -> | Ecall(name,el) ->
let* (params, st) = List.fold_left (fun acc expr -> let* (params, st) = List.fold_left (fun acc expr ->
let* (expr_list,st) = acc in 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(expr_list@[new_expr], st)
) (OK([],st)) el in ) (OK([],st)) el in
match find_function cp name with (match find_function cp name with
| OK f -> | 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 (match i with
| None -> Error (Printf.sprintf "Error while runing %s" name) | None -> Error (Printf.sprintf "Error while runing %s" name)
| Some(i) -> OK(i,st)) | Some(i) -> OK(i,st))
...@@ -40,48 +40,53 @@ let rec eval_cfgexpr oc cp st (e: expr) : (int * int Prog.state) res = ...@@ -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 let* ret = do_builtin oc st.mem name params in
(match ret with (match ret with
| Some n -> OK(n, st) | 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 match Hashtbl.find_option ht n with
| None -> Error (Printf.sprintf "Invalid node identifier\n") | None -> Error (Printf.sprintf "Invalid node identifier\n")
| Some node -> | Some node ->
match node with match node with
| Cnop succ -> | Cnop succ ->
eval_cfginstr cp oc st ht succ eval_cfginstr sp cp oc st ht succ
| Cassign(v, e, 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; Hashtbl.replace st.env v i;
eval_cfginstr cp oc st ht succ