Skip to content

GitLab

I
infosec-ecomp
Commit 9b110917 authored by Armillon Damien's avatar Armillon Damien
Browse files
Options

midle struct

parent 4b249c26
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 379 additions and 143 deletions
Makefile
View file @ 9b110917
......@@ -31,4 +31,7 @@ testFun: main.native
make -C tests DIR="type_funcall/*.e type_basic/*.e char/*.e"
testP: main.native
make -C tests DIR=ptr/*.e
\ No newline at end of file
make -C tests DIR=ptr/*.e
testS: main.native
make -C tests DIR=structs/*.e
\ No newline at end of file
expr_grammar_action.g
View file @ 9b110917
......@@ -3,6 +3,7 @@ tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA
tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
tokens SYM_VOID SYM_CHAR SYM_INT SYM_CHARACTER<char> SYM_AMPERSAND
tokens SYM_STRUCT SYM_POINT
non-terminals S INSTR INSTRS LINSTRS ELSE EXPR FACTOR
non-terminals LPARAMS REST_PARAMS
non-terminals IDENTIFIER INTEGER
......@@ -15,6 +16,7 @@ non-terminals BLOC
non-terminals IN_INSTR L_CALL_PARAMS REST_CALL_PARAMS FACTORS FACTOR_IDENTIFIER
non-terminals SYM_TYPE ASSIGN_EXPR FUNBODY
non-terminals VAR TYPE_PT
non-terminals STRUCTCONTENT STRUCTDEF DEFS STRUCTORFUN SYM_TYPE_NO_STRUCT DOTVAR
axiom S
{
......@@ -28,15 +30,20 @@ axiom S
let resolve_associativity term other =
List.fold_left (fun acc (tag, tree) -> Node(tag,acc::tree)) term other
}
rules
S -> FUNDEFS SYM_EOF { Node (Tlistglobdef, $1) }
S -> DEFS SYM_EOF { Node (Tlistglobdef, $1) }
DEFS -> FUNDEF DEFS {Node(Tfundef, $1) :: $2}
DEFS -> STRUCTDEF DEFS {$1 :: $2}
DEFS -> {[]}
STRUCTDEF -> SYM_STRUCT SYM_IDENTIFIER STRUCTORFUN {$3 $2}
STRUCTORFUN -> SYM_LBRACE STRUCTCONTENT SYM_RBRACE SYM_SEMICOLON {fun name -> Node(Tstructdef, [StringLeaf(name);Node(Tstructcontent,$2)])}
STRUCTORFUN -> SYM_IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUNBODY {fun name -> Node(Tfundef,[Node(Tstruct,[StringLeaf(name)]);StringLeaf($1);Node(Tfunargs,$3);$5])}
STRUCTCONTENT -> SYM_TYPE SYM_IDENTIFIER SYM_SEMICOLON STRUCTCONTENT {Node(Tstructelement,[$1; StringLeaf($2)])::$4}
STRUCTCONTENT -> {[]}
BLOC -> SYM_LBRACE INSTRS SYM_RBRACE {Node(Tblock, $2)}
FUNDEFS -> {[]}
FUNDEFS -> FUNDEF FUNDEFS { (Node (Tfundef, $1)) :: $2 }
FUNDEF -> SYM_TYPE SYM_IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUNBODY { [$1; StringLeaf($2); (Node(Tfunargs, $4)); $6] }
FUNDEF -> SYM_TYPE_NO_STRUCT SYM_IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS FUNBODY { [$1; StringLeaf($2); (Node(Tfunargs, $4)); $6] }
FUNBODY -> BLOC {$1}
FUNBODY -> SYM_SEMICOLON {NullLeaf}
LPARAMS -> {[]}
......@@ -54,7 +61,7 @@ ASSIGN_EXPR -> {[NullLeaf]}
INSTRS -> {[]}
INSTRS -> INSTR INSTRS {$1::$2}
INSTR -> BLOC {$1}
INSTR -> VAR IN_INSTR {$2 $1}
INSTR -> VAR IN_INSTR {$2 ($1 Tstructpoint )}
INSTR -> SYM_TYPE SYM_IDENTIFIER ASSIGN_EXPR SYM_SEMICOLON {Node(Tassign, [Node(Tassignvar , (StringLeaf $2)::$3@[$1])])}
INSTR -> SYM_IF SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC ELSE {Node(Tif, $3::$5::$6)}
INSTR -> SYM_WHILE SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS BLOC {Node(Twhile, [$3;$5])}
......@@ -87,13 +94,27 @@ FACTOR_IDENTIFIER -> {fun x -> x}
FACTOR_IDENTIFIER -> SYM_LPARENTHESIS L_CALL_PARAMS SYM_RPARENTHESIS {fun x -> Node(Tcall, x::$2)}
FACTOR -> SYM_INTEGER {IntLeaf($1)}
FACTOR -> SYM_CHARACTER {CharLeaf($1)}
FACTOR -> VAR FACTOR_IDENTIFIER {$2 $1}
FACTOR -> VAR FACTOR_IDENTIFIER {$2 ($1 Tstructunfoll)}
FACTOR -> SYM_LPARENTHESIS EXPR SYM_RPARENTHESIS {$2}
SYM_TYPE -> SYM_INT TYPE_PT {$2 (Node(Tint,[]))}
SYM_TYPE -> SYM_CHAR TYPE_PT { $2 (Node(Tchar,[]))}
SYM_TYPE -> SYM_VOID TYPE_PT {$2 (Node(Tvoid,[]))}
SYM_TYPE -> SYM_STRUCT TYPE_PT SYM_IDENTIFIER {$2 (Node(Tstruct,[StringLeaf($3)]))}
SYM_TYPE -> SYM_TYPE_NO_STRUCT {$1}
SYM_TYPE_NO_STRUCT -> SYM_INT TYPE_PT {$2 (Node(Tint,[]))}
SYM_TYPE_NO_STRUCT -> SYM_CHAR TYPE_PT { $2 (Node(Tchar,[]))}
SYM_TYPE_NO_STRUCT -> SYM_VOID TYPE_PT {$2 (Node(Tvoid,[]))}
TYPE_PT -> SYM_ASTERISK TYPE_PT {fun x -> $2 (Node(Tptr,[x]))}
TYPE_PT -> {fun x -> x}
VAR -> SYM_IDENTIFIER {StringLeaf($1)}
VAR -> SYM_ASTERISK VAR {Node(Tp,[$2])}
VAR -> SYM_AMPERSAND VAR {Node(Taddrof,[$2])}
VAR -> SYM_IDENTIFIER DOTVAR { fun x ->
let a = $2 x in
match a with
| [] -> StringLeaf($1)
| _ -> resolve_associativity (StringLeaf($1)) a
}
VAR -> SYM_ASTERISK VAR {fun x -> Node(Tp,[$2 x])}
VAR -> SYM_AMPERSAND VAR {fun x -> Node(Taddrof,[$2 x])}
DOTVAR -> SYM_POINT SYM_IDENTIFIER DOTVAR {fun x ->
let res = $3 x in
match res with
| [] -> (x,[StringLeaf $2])::[]
| _ -> (Tstructpoint,[StringLeaf $2])::res
}
DOTVAR -> {fun x -> []}
src/ast.ml
View file @ 9b110917
......@@ -31,10 +31,11 @@ type tag = Tassign | Tif | Twhile | Tblock | Treturn | Tprint
| Tneg
| Tlistglobdef
| Tfundef | Tfunname | Tfunargs | Tfunbody
| Tstructdef | Tstructcontent | Tstructelement | Tstructunfoll | Tstructpoint
| Tassignvar
| Targ | Tcall | Targs
| Taddrof | Tp
| Tvoid | Tint | Tchar | Tptr
| Tvoid | Tint | Tchar | Tptr | Tstruct
type tree = | Node of tag * tree list
| StringLeaf of string
......@@ -82,8 +83,15 @@ let string_of_tag = function
| Tchar -> "Tchar"
| Tvoid -> "Tvoid"
| Tptr -> "Tptr"
| Tstruct -> "Tstruct"
| Taddrof -> "Taddrof"
| Tp -> "Tp"
| Tstructdef -> "Tstructdef"
| Tstructcontent -> "Tstructcontent"
| Tstructelement -> "Tstructelement"
| Tstructunfoll -> "Tstructunfoll"
| Tstructpoint -> "Tstructpoint"
(* Écrit un fichier .dot qui correspond à un AST *)
......@@ -129,13 +137,14 @@ let rec string_of_ast a =
let rec is_type (tr:tree) : typ res =
match tr with
| Node(t,st) when List.length st <=1-> (match t with
| Tvoid -> OK(Tvoid)
| Tint -> OK(Tint)
| Tchar -> OK(Tchar)
| Tptr ->
let* subtype = is_type (List.hd st) in
| Node(t,st) when List.length st <=1-> (match t,st with
| Tvoid,_ -> OK(Tvoid)
| Tint,_ -> OK(Tint)
| Tchar,_ -> OK(Tchar)
| Tptr, [st] ->
let* subtype = is_type st in
OK(Prog.Tptr (subtype))
| Tstruct, [StringLeaf name] -> OK(Prog.Tstruct name)
| _ -> Error "Not a type")
| _ ->Error (Format.sprintf "Not a type: %s" (string_of_ast tr))
\ No newline at end of file
src/cfg_gen.ml
View file @ 9b110917
......@@ -8,34 +8,34 @@ open Cfg_print
open Options
open Elang_gen
(* [cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e] converts an [Elang.expr] into a [expr res]. This should
(* [cfg_expr_of_eexpr struct_table 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 fun_typ (funvartyp: (string, typ) Hashtbl.t) (funvarinmem: (string, int) Hashtbl.t) (e: Elang.expr) : expr res =
let rec cfg_expr_of_eexpr struct_table 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) ->
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
let* t1 = type_expr struct_table funvartyp fun_typ e1 in
let* t2 = type_expr struct_table funvartyp fun_typ e2 in
let* value1 = cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e1 in
let* value2 = cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e2 in
(match t1 with
| Tptr t ->
let* size = size_type t in
let* size = size_type t struct_table in
OK(Ebinop(b, value1, Ebinop(Emul, value2, Eint size)))
| _ ->
(match t2 with
| Tptr t ->
let* size = size_type t in
let* size = size_type t struct_table in
OK(Ebinop(b, (Ebinop(Emul, value1, Eint size)), value2))
| _ ->
OK (Ebinop (b, value1, value2))
))
| Elang.Eunop (u, e) ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun ee ->
cfg_expr_of_eexpr struct_table 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))
......@@ -43,12 +43,12 @@ let rec cfg_expr_of_eexpr fun_typ (funvartyp: (string, typ) Hashtbl.t) (funvarin
(
match Hashtbl.find_option funvarinmem v with
| Some offset ->
let* mem_to_read = size_type (Hashtbl.find funvartyp v) in
let* mem_to_read = size_type (Hashtbl.find funvartyp v) struct_table 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 fun_typ funvartyp funvarinmem) elist in
let* args_expr = list_map_res (cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem) elist in
OK(Cfg.Ecall(name, args_expr))
| Elang.Eaddrof (e) ->
(match e with
......@@ -60,15 +60,16 @@ let rec cfg_expr_of_eexpr fun_typ (funvartyp: (string, typ) Hashtbl.t) (funvarin
| _ -> 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
let* cfg_e = cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e in
let* type_to_load = type_expr struct_table funvartyp fun_typ e in
(match type_to_load with
| Tptr t ->
let* size = size_type t in
let* size = size_type t struct_table in
OK(Eload(cfg_e,size))
| _ -> Error "Can't load non pointer")
| _ -> Error "souffle dans mon trou"
(* [cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg succ i] builds the CFG node(s) that correspond
(* [cfg_node_of_einstr struct_table 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.
......@@ -83,55 +84,56 @@ let rec cfg_expr_of_eexpr fun_typ (funvartyp: (string, typ) Hashtbl.t) (funvarin
Hint: several nodes may be generated for a single E instruction.
*)
let rec cfg_node_of_einstr fun_typ funvartyp (funvarinmem: (string, int) Hashtbl.t) (next: int) (cfg : (int, cfg_node) Hashtbl.t)
let rec cfg_node_of_einstr struct_table 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) ->
let* value = cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e in
let* value = cfg_expr_of_eexpr struct_table 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
let* size_write = size_type type_var struct_table 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
let* e = cfg_expr_of_eexpr struct_table 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 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) ->
cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem c >>= fun c ->
cfg_node_of_einstr struct_table fun_typ funvartyp funvarinmem next cfg succ ithen >>= fun (nthen, next) ->
cfg_node_of_einstr struct_table 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 fun_typ funvartyp funvarinmem c >>= fun c ->
cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem c >>= fun c ->
let (cmp, next) = (next, next + 1) in
cfg_node_of_einstr fun_typ funvartyp funvarinmem next cfg cmp i >>= fun (nthen, next) ->
cfg_node_of_einstr struct_table 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 fun_typ funvartyp funvarinmem next cfg succ i
cfg_node_of_einstr struct_table fun_typ funvartyp funvarinmem next cfg succ i
) il (OK (succ, next))
| Elang.Ireturn e ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun e ->
cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e >>= fun e ->
Hashtbl.replace cfg next (Creturn e); OK (next, next + 1)
| Elang.Iprint e ->
cfg_expr_of_eexpr fun_typ funvartyp funvarinmem e >>= fun e ->
cfg_expr_of_eexpr struct_table 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 fun_typ funvartyp funvarinmem) elist in
let* args_expr = list_map_res (cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem) elist in
Hashtbl.replace cfg next (Ccall(name, args_expr, succ));
OK (next,next+1)
| 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
let* addr = cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e1 in
let* value = cfg_expr_of_eexpr struct_table fun_typ funvartyp funvarinmem e2 in
let* t = type_expr struct_table funvartyp fun_typ e1 in
let* size_write = size_type t struct_table in
Hashtbl.replace cfg next (Cstore(addr,value,size_write, succ));
OK(next, next+1)
| _ -> Error "soufle dans mon trou"
......@@ -156,10 +158,10 @@ 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 fun_typ { funargs; funbody; funvartyp; funvarinmem; funstksz } =
let cfg_fun_of_efun struct_table fun_typ { funargs; funbody; funvartyp; funvarinmem; funstksz } =
let cfg = Hashtbl.create 17 in
Hashtbl.replace cfg 0 (Creturn (Eint 0));
cfg_node_of_einstr fun_typ funvartyp funvarinmem 1 cfg 0 funbody >>= fun (node, _) ->
cfg_node_of_einstr struct_table 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;
......@@ -169,20 +171,21 @@ let cfg_fun_of_efun fun_typ { funargs; funbody; funvartyp; funvarinmem; funstksz
cfgfunstksz = funstksz;
}
let cfg_gdef_of_edef fun_typ gd =
let cfg_gdef_of_edef struct_table fun_typ gd =
match gd with
Gfun f -> cfg_fun_of_efun fun_typ f >>= fun f -> OK (Gfun f)
Gfun f -> cfg_fun_of_efun struct_table fun_typ f >>= fun f -> OK (Gfun f)
let cfg_prog_of_eprog (ep: eprog) : cfg_fun prog res =
let fun_typ = Hashtbl.create (3+(List.length ep)) in
let (fun_list, struct_table) = ep in
let fun_typ = Hashtbl.create (3+(List.length fun_list)) in
List.iter (fun (name,pro) ->
match pro with
| Gfun f -> Hashtbl.replace fun_typ name ((snd (List.split f.funargs)),f.funrettype);
)ep;
)fun_list;
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
assoc_map_res (fun fname -> cfg_gdef_of_edef struct_table fun_typ) fun_list
let pass_cfg_gen ep =
match cfg_prog_of_eprog ep with
......
src/elang.ml
View file @ 9b110917
......@@ -16,6 +16,7 @@ type expr =
| Ecall of string * expr list
| Eaddrof of expr
| Eload of expr
| Egetfield of expr * string
type instr =
| Iassign of string * expr
......@@ -26,6 +27,7 @@ type instr =
| Iprint of expr
| Icall of string * expr list
| Istore of expr * expr
| Isetfield of expr * string * expr
type efun = {
funargs: ( string * typ ) list;
......@@ -36,4 +38,4 @@ type efun = {
funstksz : int
}
type eprog = efun prog
type eprog = efun prog * (string, (string * typ) list) Hashtbl.t
src/elang_gen.ml
View file @ 9b110917
This diff is collapsed.
src/elang_print.ml
View file @ 9b110917
......@@ -30,6 +30,7 @@ let rec dump_eexpr = function
| Echar c -> Printf.sprintf "'%c'" c
| Eload e -> Printf.sprintf "*%s" (dump_eexpr e)
| Eaddrof e -> Printf.sprintf "&%s" (dump_eexpr e)
| Egetfield (e,f) -> Printf.sprintf "%s.%s" (dump_eexpr e) f
let indent_size = 2
let spaces n =
......@@ -63,7 +64,8 @@ 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)
| Isetfield (e1,f,e2) -> Format.fprintf oc "%s.%s = %s;\n" (dump_eexpr e1) f (dump_eexpr e2)
let dump_einstr oc i = dump_einstr_rec 0 oc i
......
src/elang_run.ml
View file @ 9b110917
......@@ -34,20 +34,21 @@ let eval_unop (u: unop) : int -> int =
(* [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 fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (int * int Prog.state) res =
let (fun_list, struct_table) = ep in
match e with
| Ebinop(op,expr1,expr2) ->
let* t1 = type_expr func_env.funvartyp fun_typ expr1 in
let* t2 = type_expr func_env.funvartyp fun_typ expr2 in
let* t1 = type_expr struct_table func_env.funvartyp fun_typ expr1 in
let* t2 = type_expr struct_table 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
let* size = size_type t struct_table in
OK((eval_binop op value1 (value2 * size)), st)
| _ ->
(match t2 with
| Tptr t ->
let* size = size_type t in
let* size = size_type t struct_table in
OK((eval_binop op (value1 * size) value2), st)
| _ ->
OK((eval_binop op value1 value2), st)
......@@ -62,7 +63,7 @@ let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (in
| 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* mem_to_read = size_type (Hashtbl.find func_env.funvartyp str) struct_table 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))
......@@ -75,7 +76,7 @@ let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : 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
(match find_function fun_list name with
| OK f ->
let* (res,st) = eval_efun fun_typ oc ep st (sp+ f.funstksz) f name args in
(match res with
......@@ -88,21 +89,23 @@ let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (in
| None -> Error (Format.sprintf "Error: %s doesn't return anything" name)))
| Eload e ->
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
let* type_to_load = type_expr struct_table func_env.funvartyp fun_typ e in
(match type_to_load with
| Tptr t ->
let* size = size_type t in
let* size = size_type t struct_table 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
(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"
| _ -> Error "& can only be applied on var")
| Egetfield (e,s) -> Error "Egetfield not here yet"
(* [eval_einstr fun_typ oc st ins] évalue l'instrution [ins] en partant de l'état [st].
(* [eval_einstr struct_table 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].
......@@ -116,6 +119,7 @@ let rec eval_eexpr fun_typ oc (ep: eprog) st (sp: int) func_env (e : expr) : (in
- [st'] est l'état mis à jour. *)
and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: instr) :
(int option * int state) res =
let (fun_list, struct_table) = ep in
let rec eval_list_instrs st li : (int option * int state) res =
match li with
| [] -> OK(None,st)
......@@ -139,7 +143,7 @@ and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: i
(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* size_write = size_type type_var struct_table 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)
......@@ -170,7 +174,7 @@ and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: i
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
(match find_function fun_list name with
| OK f ->
let* (_,st) = eval_efun fun_typ oc ep st (sp + f.funstksz) f name args in
OK (None,st)
......@@ -180,18 +184,33 @@ and eval_einstr fun_typ oc (ep: eprog) (st: int state) (sp:int) func_env (ins: i
| Istore(e1, e2) ->
let* (addr,st) = eval_eexpr fun_typ oc ep st sp func_env e1 in
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* t = type_expr struct_table func_env.funvartyp fun_typ e1 in
let* size_write = size_type t struct_table 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)
| Isetfield(e1,str,e2) -> (
let* (addr,st) = eval_eexpr fun_typ oc ep st sp func_env e1 in
let* (value,st) = eval_eexpr fun_typ oc ep st sp func_env e2 in
let* t = type_expr struct_table func_env.funvartyp fun_typ e1 in
match t with
| Tptr (Tstruct name) -> (
let* offset = field_offset struct_table name str in
let* affect_type = field_type struct_table name str in
let* size_write = size_type affect_type struct_table 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)
)
| _ -> Error (Printf.sprintf "%s is not a struct. can't do Isetfield" (string_of_typ t))
)
(* [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 fun_typ]. *)
pour [eval_einstr struct_table 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 =
......@@ -231,16 +250,17 @@ and eval_efun fun_typ oc (ep: eprog) (st: int state) (sp: int) (f: efun)
*)
let eval_eprog oc (ep: eprog) (memsize: int) (params: int list)
: int option res =
let (fun_list, struct_table) = ep in
let st = init_state memsize in
let fun_typ = Hashtbl.create (3+(List.length ep)) in
let fun_typ = Hashtbl.create (3+(List.length fun_list)) in
List.iter (fun (name,pro) ->
match pro with
| Gfun f -> Hashtbl.replace fun_typ name ((snd (List.split f.funargs)),f.funrettype);
)ep;
)fun_list;
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 ->
find_function fun_list "main" >>= fun f ->
(* ne garde que le nombre nécessaire de paramètres pour la fonction "main". *)
let n = List.length f.funargs in
let params = take n params in
......
src/prog.ml
View file @ 9b110917
......@@ -73,6 +73,7 @@ type typ =
| Tchar
| Tvoid
| Tptr of typ
| Tstruct of string
let rec string_of_typ t =
match t with
......@@ -80,10 +81,52 @@ let rec string_of_typ t =
| Tchar -> "char"
| Tvoid -> "void"
| Tptr ptt-> Printf.sprintf "%s*" (string_of_typ ptt)
| Tstruct str -> Printf.sprintf "struct %s" str
let size_type (t: typ) : int res =
let rec size_type (t: typ) (struct_table: (string, (string * typ) list) Hashtbl.t): int res =
match t with
| Tint -> OK (Archi.wordsize () )
| Tptr _ -> OK (Archi.nbits () /8)
| Tchar -> OK 1
| Tvoid -> Error "Void can't be stored in memory"
\ No newline at end of file
| Tvoid -> Error "Void can't be stored in memory"
| Tstruct str ->
match Hashtbl.find_option struct_table str with
| None -> Error (Printf.sprintf "struct not found: %s in %s" str (string_of_string_set (Set.of_list (fst (List.split (Hashtbl.to_list struct_table))))))
| Some contentl -> List.fold_left (fun acc (_,t) ->
let* acc = acc in
let* s = size_type t struct_table in
OK (acc + s)
) (OK 0) contentl
let rec field_offset
(structs: (string, (string * typ) list) Hashtbl.t)
(s: string) (f: string) : int res =
match Hashtbl.find_option structs s with
| Some l ->
let* (offset,found) = List.fold_left (fun acc (field, fieldtyp) ->
let* (offset, found) = acc in
if found then OK(offset, found)
else (
Printf.printf "f: %s field: %s %b\n" f field (field = f);
if field = f then OK(offset, true)
else
let* size = size_type fieldtyp structs in
OK(offset + size, false))
) (OK (0,false)) l in
if not found
then Error (Printf.sprintf "Field %s not found in %s (%s)" f s (string_of_string_set (Set.of_list (fst(List.split l)))))
else OK offset
| None -> Error (Printf.sprintf "struct not found there: %s" s)
let rec field_type
(structs: (string, (string * typ) list) Hashtbl.t)
(s: string) (f: string) : typ res =
match Hashtbl.find_option structs s with
| Some l ->
let ft = List.assoc_opt f l in
(match ft with
| Some t -> OK t
| None -> Error (Printf.sprintf "Field %s not found in %s (%s)" f s (string_of_string_set (Set.of_list (fst(List.split l))))))
| None -> Error (Printf.sprintf "struct not found: %s" s)
\ No newline at end of file
tests/invader/invader.e
View file @ 9b110917
......@@ -231,7 +231,7 @@ int main(int argc, char* argv)
init_sprite(sprite_alien4, 0x81, 0x42, 0x3c, 0x5a, 0x5a, 0x3c, 0x42, 0x81);
init_sprite(sprite_alien5, 0x41, 0x22, 0x3e, 0x6b, 0x49, 0x7f, 0x3e, 0x55);
/*
0x41 .#....#.
0x41 .#.....#
0x22 ..#...#.
0x3e ..#####.
0x6b .##.#.##
......
tests/structs/fun_struct.e 0 → 100644
View file @ 9b110917
struct point {
int x;
int y;
};
struct point f(int x, int y) {
struct point p;
p.x = x;
p.y = y;
return p;
}
int main() {
struct point p;
p = f(1,2);
return p.y;
}
\ No newline at end of file
tests/structs/fun_struct.e.expect_1_2_3 0 → 100644
View file @ 9b110917
{"output": "", "error": null, "retval": 2}
\ No newline at end of file