Commit 15868ca6 authored by Armillon Damien's avatar Armillon Damien
Browse files

pointer run

parent 02c17a4a
......@@ -70,10 +70,10 @@ let rec type_expr
| Some (_,t) -> OK t
| None -> Error (Format.sprintf "function %s not found (unknown type)" func)
)
| Eload (e) ->
| Eaddrof (e) ->
let* type_e = type_expr typ_var typ_fun e in
OK(Tptr type_e)
| Eaddrof e ->
| Eload e ->
let* type_e = type_expr typ_var typ_fun e in
match type_e with
| Tptr t -> OK t
......@@ -89,6 +89,7 @@ let are_types_compatible (t1: typ) (t2:typ): typ res =
)
| Tptr t -> (
match t2 with
| Tptr t' -> if t = t' then OK(t) else Error "Pointer of two different types"
| Tint -> OK(Tint)
| _ -> Error "Incompatible type: pointers are integers"
)
......@@ -163,7 +164,6 @@ let gen_funvarinmem i funvartyp: ((string, int )Hashtbl.t * int) res=
OK (table, size + offset)
) var_in_mem (OK (Hashtbl.create (Set.cardinal var_in_mem), 0))
(* [make_eexpr_of_ast a] builds an expression corresponding to a tree [a]. If
the tree is not well-formed, fails with an [Error] message. *)
let rec make_eexpr_of_ast (a: tree)
......@@ -207,7 +207,7 @@ let rec make_eexpr_of_ast (a: tree)
| Node(Tp, [e1]) ->
let* (expr, t) = make_eexpr_of_ast e1 typ_var typ_fun in
(match t with
| Tptr t -> OK(Eload(expr), t)
| Tptr t -> OK(Eload expr, t)
| _ -> Error (Printf.sprintf "Can't Load non pointer here %s" (string_of_ast a)))
| Node(Taddrof, [e1]) ->
let* (expr, t) = make_eexpr_of_ast e1 typ_var typ_fun in
......@@ -273,7 +273,9 @@ let rec make_einstr_of_ast (a: tree) typ_var typ_fun ret_typ: instr res =
let* (affected_expr, t1) = make_eexpr_of_ast varTree typ_var typ_fun in
let* (affectation, t2) = make_eexpr_of_ast e1 typ_var typ_fun in
let* _ = are_types_compatible t1 t2 in
OK(Istore(affected_expr, affectation))
(match affected_expr with
| Eload e -> OK(Istore(e, affectation))
| _ -> Error "This error should not be triggered, I just unpile a useless expression")
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a))
)
......@@ -290,7 +292,7 @@ let rec make_einstr_of_ast (a: tree) typ_var typ_fun ret_typ: instr res =
make_eexpr_of_ast e1 typ_var typ_fun>>= fun (expr1,ty) ->
(match are_types_compatible ret_typ ty with
| OK(t) -> OK(Ireturn expr1)
| Error q-> Error (Format.sprintf "Bad return type"))
| Error q-> Error (Format.sprintf "Bad return type %s vs %s" (string_of_typ ret_typ) (string_of_typ ty)))
| _ -> Error (Printf.sprintf "Unacceptable ast in make_einstr_of_ast %s" (string_of_ast a))
in
......
......@@ -63,7 +63,7 @@ let rec dump_einstr_rec indent oc i =
print_spaces oc indent;
Format.fprintf oc "print %s;\n" (dump_eexpr e)
| Icall (name,expr_list) -> Format.fprintf oc "%s(%s);\n" name (String.concat ", " (List.map dump_eexpr expr_list))
| Istore (e1,e2) -> Format.fprintf oc "%s = %s;\n" (dump_eexpr e1) (dump_eexpr e2)
| Istore (e1,e2) -> Format.fprintf oc "*%s <- %s;\n" (dump_eexpr e1) (dump_eexpr e2)
let dump_einstr oc i = dump_einstr_rec 0 oc i
......
......@@ -5,6 +5,7 @@ open Prog
open Utils
open Builtins
open Utils
open Elang_gen
let binop_bool_to_int f x y = if f x y then 1 else 0
......@@ -30,34 +31,53 @@ let eval_unop (u: unop) : int -> int =
match u with
| Eneg -> fun x -> -x
(* [eval_eexpr oc ep st e] évalue l'expression [e] dans l'état [st]. Renvoie une
(* [eval_eexpr fun_typ oc ep st e] évalue l'expression [e] dans l'état [st]. Renvoie une
erreur si besoin. *)
let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (int * int Prog.state) res =
match e with
| Ebinop(op,expr1,expr2) ->
let* (value1, st) = eval_eexpr oc ep st expr1 in
let* (value2, st) = eval_eexpr oc ep st expr2 in
OK((eval_binop op value1 value2), st)
let* t1 = type_expr func_env.funvartyp fun_typ expr1 in
let* t2 = type_expr func_env.funvartyp fun_typ expr2 in
let* (value1, st) = eval_eexpr fun_typ oc ep st sp func_env expr1 in
let* (value2, st) = eval_eexpr fun_typ oc ep st sp func_env expr2 in
(match t1 with
| Tptr t ->
let* size = size_type t in
OK((eval_binop op value1 (value2 * size)), st)
| _ ->
(match t2 with
| Tptr t ->
let* size = size_type t in
OK((eval_binop op (value1 * size) value2), st)
| _ ->
OK((eval_binop op value1 value2), st)
))
| Eunop(op,expr) ->
let* (value,st) = eval_eexpr oc ep st expr in
let* (value,st) = eval_eexpr fun_typ oc ep st sp func_env expr in
OK((eval_unop op value), st)
| Evar(str) ->
(match Hashtbl.find_option st.env str with
| None -> Error (Format.sprintf "Unknown variable %s\n" str)
| Some(name) -> OK(name, st))
| None -> (
match Hashtbl.find_option func_env.funvarinmem str with
| Some offset ->
let* mem_to_read = size_type (Hashtbl.find func_env.funvartyp str) in
let* value = Mem.read_bytes_as_int st.mem offset (mem_to_read) in
OK(value,st)
| None -> Error (Format.sprintf "Unknown variable %s\n" str))
| Some(value) -> OK(value, st))
| Eint(n) -> OK(n, st)
| Echar c -> OK(Char.code c,st)
| Ecall(name,expr_list) ->
let* (args, st) = List.fold_left (fun acc expr ->
let* (expr_l, st) = acc in
let* (arg_expr, st) = eval_eexpr oc ep st expr in
let* (arg_expr, st) = eval_eexpr fun_typ oc ep st sp func_env expr in
OK(expr_l@[arg_expr], st)
) (OK([], st)) expr_list in
(match find_function ep name with
| OK f ->
let* (res,st) = eval_efun oc ep st f name args in
let* (res,st) = eval_efun fun_typ oc ep st (sp+ f.funstksz) f name args in
(match res with
| Some(n) -> OK(n, st)
| None -> Error (Format.sprintf "Error with function %s" name))
......@@ -66,9 +86,23 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
(match ret with
| Some n -> OK(n, st)
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)))
| _ -> Error "bababa"
(* [eval_einstr oc st ins] évalue l'instrution [ins] en partant de l'état [st].
| 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
(match type_to_load with
| Tptr t ->
let* size = size_type t in
let* value = Mem.read_bytes_as_int st.mem addr size in
OK(value, st)
| _ -> Error "Can't load non pointer")
| Eaddrof e ->
match e with
| Evar str ->
let offset = Hashtbl.find func_env.funvarinmem str in
OK(offset + sp,st)
| _ -> Error "& can only be applied on var"
(* [eval_einstr fun_typ oc st ins] évalue l'instrution [ins] en partant de l'état [st].
Le paramètre [oc] est un "output channel", dans lequel la fonction "print"
écrit sa sortie, au moyen de l'instruction [Format.fprintf].
......@@ -80,20 +114,20 @@ let rec eval_eexpr oc (ep: eprog) st (e : expr) : (int * int Prog.state) res =
lieu et que l'exécution doit continuer.
- [st'] est l'état mis à jour. *)
and eval_einstr oc (ep: eprog) (st: int state) (ins: instr) :
and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: instr) :
(int option * int state) res =
let rec eval_list_instrs st li : (int option * int state) res =
match li with
| [] -> OK(None,st)
| instr::next_instrs -> eval_einstr oc ep st instr >>= fun result ->
| instr::next_instrs -> eval_einstr fun_typ oc ep st sp func_env instr >>= fun result ->
match result with
| (None, st) -> eval_list_instrs st next_instrs
| (Some(n), st) -> OK(result)
in
let rec eval_while st e i: (int option * int state) res =
let* (condition,st) = eval_eexpr oc ep st e in
let* (condition,st) = eval_eexpr fun_typ oc ep st sp func_env e in
if condition = 1 then
eval_einstr oc ep st i >>= fun result_loop ->
eval_einstr fun_typ oc ep st sp func_env i >>= fun result_loop ->
match result_loop with
| (None, st)-> (eval_while st e i)
| (Some(n), st) -> OK(result_loop)
......@@ -101,46 +135,65 @@ and eval_einstr oc (ep: eprog) (st: int state) (ins: instr) :
in
match ins with
| Iassign(str, expr) ->
let* (value, st) = eval_eexpr oc ep st expr in
Hashtbl.replace st.env str value;
OK(None,st)
let* (value, st) = eval_eexpr fun_typ oc ep st sp func_env expr in
(match Hashtbl.find_option func_env.funvarinmem str with
| Some offset ->
let type_var = Hashtbl.find func_env.funvartyp str in
let* size_write = size_type type_var in
let bytes_to_write = split_bytes (size_write) value in
let* value = Mem.write_bytes st.mem offset bytes_to_write in
OK(None,st)
| None ->
Hashtbl.replace st.env str value;
OK(None,st))
| Iif(expr,instr1,instr2) ->
let* (condition,st) = eval_eexpr oc ep st expr in
if condition=1 then eval_einstr oc ep st instr1 else eval_einstr oc ep st instr2
let* (condition,st) = eval_eexpr fun_typ oc ep st sp func_env expr in
if condition=1 then eval_einstr fun_typ oc ep st sp func_env instr1 else eval_einstr fun_typ oc ep st sp func_env instr2
| Iwhile(expr,instr) -> eval_while st expr instr
| Iblock(instrs) -> eval_list_instrs st instrs
| Ireturn(expr) ->
let* (result,st) = eval_eexpr oc ep st expr
let* (result,st) = eval_eexpr fun_typ oc ep st sp func_env expr
in OK(Some(result), st)
| Iprint(expr) ->
let* (result, st) = eval_eexpr oc ep st expr in
let* (result, st) = eval_eexpr fun_typ oc ep st sp func_env expr in
Format.fprintf oc "%d\n" result; OK(None, st)
| Icall(name,expr_list) ->
let* (args, st) = List.fold_left (fun acc expr ->
let* (expr_l, st) = acc in
let* (arg_expr, st) = eval_eexpr oc ep st expr in
let* (arg_expr, st) = eval_eexpr fun_typ oc ep st sp func_env expr in
OK(expr_l@[arg_expr], st)
) (OK([], st)) expr_list in
(match find_function ep name with
| OK f -> eval_efun oc ep st f name args
| OK f ->
let* (_,st) = eval_efun fun_typ oc ep st (sp + f.funstksz) f name args in
OK (None,st)
| Error _ ->
let* ret = do_builtin oc st.mem name args in
OK (ret, st))
| _ -> Error("nananana")
| 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
let bytes_to_write = split_bytes (size_write) value in
let* _ = Mem.write_bytes st.mem addr bytes_to_write in
OK(None,st)
(* [eval_efun oc st f fname vargs] évalue la fonction [f] (dont le nom est
(* [eval_efun fun_typ oc st f fname vargs] évalue la fonction [f] (dont le nom est
[fname]) en partant de l'état [st], avec les arguments [vargs].
Cette fonction renvoie un couple (ret, st') avec la même signification que
pour [eval_einstr]. *)
and eval_efun oc (ep: eprog) (st: int state) ({ funargs; funbody}: efun)
pour [eval_einstr fun_typ]. *)
and eval_efun fun_typ oc (ep: eprog) (st: int state) (sp: int) (f: efun)
(fname: string) (vargs: int list)
: (int option * int state) res =
(* L'environnement d'une fonction (mapping des variables locales vers leurs
......@@ -148,11 +201,12 @@ and eval_efun oc (ep: eprog) (st: int state) ({ funargs; funbody}: efun)
variables de l'appelant. Donc, on sauvegarde l'environnement de l'appelant
dans [env_save], on appelle la fonction dans un environnement propre (Avec
seulement ses arguments), puis on restore l'environnement de l'appelant. *)
let { funargs; funbody; funstksz; funvarinmem; funrettype} = f in
let env_save = Hashtbl.copy st.env in
let env = Hashtbl.create 17 in
match List.iter2 (fun a v -> Hashtbl.replace env a v) (fst (List.split funargs)) vargs with
| () ->
eval_einstr oc ep { st with env } funbody >>= fun (v, st') ->
eval_einstr fun_typ oc ep { st with env } sp f funbody >>= fun (v, st') ->
OK (v, { st' with env = env_save })
| exception Invalid_argument _ ->
Error (Format.sprintf
......@@ -179,6 +233,14 @@ and eval_efun oc (ep: eprog) (st: int state) ({ funargs; funbody}: efun)
let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
: int option res =
let st = init_state memsize in
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);
find_function ep "main" >>= fun f ->
(* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *)
let n = List.length f.funargs in
......@@ -186,5 +248,5 @@ let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
let { env } = st in
let { funargs } = f in
List.iter2 (fun argname argval -> Hashtbl.replace env argname argval) (fst (List.split funargs)) params;
eval_efun oc ep st f "main" params >>= fun (v, st) ->
eval_efun fun_typ oc ep st 0 f "main" params >>= fun (v, st) ->
OK v
......@@ -83,7 +83,7 @@ let rec string_of_typ t =
let size_type (t: typ) : int res =
match t with
| Tint
| Tptr _ -> OK (Archi.nbits ())
| Tchar -> OK 8
| Tint -> OK (32/8)
| Tptr _ -> OK (Archi.nbits () /8)
| Tchar -> OK 1
| Tvoid -> Error "Void can't be stored in memory"
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment