summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compile.ml307
1 files changed, 298 insertions, 9 deletions
diff --git a/compile.ml b/compile.ml
index e05f188..0393838 100644
--- a/compile.ml
+++ b/compile.ml
@@ -3,18 +3,307 @@ open Mips
open Ast
open Utils
open Closure
+open Optimize
+open Primitives
-let rec compile_expr _ = {text = [] ; data = []}
-and compile_letfuns _ = {text = [] ; data = []}
+module Smap = Map.Make(String)
+
+type env = { mutable addrs : ident_address Smap.t ;
+ mutable fp : int }
+let empty_env = { addrs = Smap.empty ; fp = 0 }
+
+let frame_size = ref 0
+
+let next_string_id = ref 1
+let next_jump_id = ref 1
+
+let heap_push n =
+ Addi (SP, SP, - n)
+let heap_pop n =
+ Addi (SP, SP, n)
+
+let push reg =
+ [Addi (SP, SP, -4) ;
+ Sw (reg, (0, SP))]
+
+let pop reg =
+ [Lw (reg, (0, SP)) ;
+ Addi (SP, SP, 4)]
+
+let malloc n =
+ [Li (V0, 9) ;
+ Li (A0, n) ;
+ Syscall]
+
+(* Compilation des listes :
+ allocation d'un bloc de 4 + 4 = 8 octets contenant, en supposant que
+ l'adresse soit dans le registre V0, la valeur ou le pointeur de la valeur
+ de tête dans 0(V0), et le pointeur vers la queue dans 4(V0) *)
+
+let new_string_label () =
+ let label = Printf.sprintf "string___%d" !next_string_id
+ in
+ incr next_string_id;
+ label
+
+let new_jump_label () =
+ let label = Printf.sprintf "jump___%d" !next_jump_id
+ in
+ incr next_jump_id;
+ label
+
+let assign_ident env ident =
+ if !frame_size = env.fp then frame_size := 4 + !frame_size;
+ let new_addrs = Smap.add ident (Areg (env.fp, FP)) env.addrs
+ and curr_fp = env.fp
+ in
+ [Lw (V0, (curr_fp, FP))], { addrs = new_addrs ; fp = env.fp + 4 }
+
+let rec assign_motif env m =
+ match m.m with
+ | Munderscore -> [], env
+ | Mident ident -> assign_ident env ident
+ | Mtuple l ->
+ let i = ref (-1)
+ in
+ let instrs, env =
+ List.fold_left (fun (base_instrs, env) m ->
+ let instrs, env2 = assign_motif env m
+ in
+ incr i;
+ (base_instrs
+ @
+ [Lw (V0, (0, SP)) ;
+ Lw (V0, (4 * !i, V0))]
+ @
+ instrs, env2))
+ ([heap_push 4 ;
+ Sw (V0, (0, SP))], env)
+ l
+ in
+ instrs @ [heap_pop 4], env
+
+let ident_to_reg env ident reg =
+ match Smap.find ident env.addrs with
+ | Alab label -> [Lw_label (reg, label)]
+ | Areg radd -> [Lw (reg, radd)]
+
+(* Compile une expression, et assure que le résultat sera dans V0 *)
+let rec compile_expr env expr =
+ match expr.e with
+ | Econst (Cint c) ->
+ [Li (V0, c)]
+ | Econst (Cstring s) ->
+ let label = new_string_label ()
+ in
+ [Asciiz (label, s);
+ La (V0, label)]
+ | Econst (Cbool true) ->
+ [Li (V0, 1)]
+ | Econst (Cbool false)
+ | Econst Cunit
+ | Econst Cemptylist ->
+ [Li (V0, 0)]
+ | Eident ident ->
+ ident_to_reg env ident V0
+ | Etuple l ->
+ let len = List.length l
+ and i = ref (-1)
+ in
+ malloc (4 * len)
+ @
+ [heap_push 4 ;
+ Sw (V0, (0, SP))]
+ @
+ (List.fold_left (fun base e ->
+ incr i;
+ base
+ @
+ (compile_expr env e)
+ @
+ [Lw (T0, (0, SP)) ;
+ Sw (V0, (4 * !i, T0))])
+ [] l)
+ @
+ [heap_pop 4]
+ | Ebinop (e1, o, e2) ->
+ (compile_expr env e1)
+ @
+ [heap_push 4 ;
+ Sw (V0, (0, SP))]
+ @
+ (compile_expr env e2)
+ @
+ [Lw (A0, (0, SP)) ;
+ begin
+ match o with
+ | OAdd -> Add (V0, V0, A0)
+ | OSub -> Sub (V0, V0, A0)
+ | OMul -> Mul (V0, V0, A0)
+ | ODiv -> Div (V0, V0, A0)
+ | OAnd -> And (V0, V0, A0)
+ | OOr -> Or (V0, V0, A0)
+ | OEq -> Seq (V0, V0, A0)
+ | ONeq -> Sne (V0, V0, A0)
+ | OLt -> Slt (V0, V0, A0)
+ | OLe -> Sle (V0, V0, A0)
+ | OGt -> Sgt (V0, V0, A0)
+ | OGe -> Sge (V0, V0, A0)
+ end ;
+ heap_pop 4]
+ | Eunop (o, e) ->
+ (compile_expr env e)
+ @
+ [begin
+ match o with
+ | ONot -> Not (V0, V0)
+ | ONeg -> Neg (V0, V0)
+ end]
+ | Eletin (m, val_expr, body_expr) ->
+ let val_instrs = compile_expr env val_expr
+ and set_instrs, env2 = assign_motif env m
+ in
+ val_instrs
+ @
+ set_instrs
+ @
+ (compile_expr env2 body_expr)
+ | Eif (cond_expr, then_expr, else_expr) ->
+ let else_label = new_jump_label ()
+ and end_label = new_jump_label ()
+ in
+ (compile_expr env cond_expr)
+ @
+ [Blez (V0, else_label)]
+ @
+ (compile_expr env then_expr)
+ @
+ [J end_label ;
+ Label else_label]
+ @
+ (compile_expr env else_expr)
+ @
+ [Label end_label]
+ | Elistcons (head_expr, tail_expr) ->
+ (compile_expr env head_expr)
+ @
+ [heap_push 8 ; (* On réserve direct les deux blocs pour backup
+ de la valeur de tête de de queue *)
+ Sw (V0, (4, SP))]
+ @
+ (compile_expr env tail_expr)
+ @
+ [Sw (V0, (0, SP))]
+ @
+ (malloc 8)
+ @
+ [Lw (A1, (0, SP)) ;
+ Lw (A0, (4, SP)) ;
+ Sw (A0, (0, V0)) ;
+ Sw (A1, (4, V0)) ;
+ heap_pop 8]
+ | Ecall (func_expr, arg_expr) ->
+ (compile_expr env func_expr)
+ @
+ [heap_push 4 ;
+ Sw (V0, (0, SP))]
+ @
+ (compile_expr env arg_expr)
+ @
+ [Move (A1, V0) ; (* Cloture dans A0, argument dans A1,
+ adresse du bloc de code dans T0 *)
+ Lw (A0, (0, SP)) ;
+ Lw (T0, (0, A0)) ;
+ Jalr (T0, RA)]
+ | Ematch (match_expr, empty_expr, head_m, tail_m, result_expr) ->
+ (* Petit trick : a::b est représenté comme (a, b) dans la
+ mémoire, abusons donc le processus pour faciliter l'assignation
+ Note : on pourrait (en plus) remplacer le match par un if
+ bien placé, mais ça serait vraiment coquin *)
+ let empty_label = new_jump_label ()
+ and end_label = new_jump_label ()
+ and set_instrs, env2 = assign_motif env
+ (raw_motif (Mtuple [head_m ;
+ tail_m]))
+ in
+ (compile_expr env match_expr)
+ @
+ [Blez (V0, empty_label)]
+ @
+ set_instrs
+ @
+ (compile_expr env2 result_expr)
+ @
+ [J end_label ;
+ Label empty_label]
+ @
+ (compile_expr env empty_expr)
+ @
+ [Label end_label]
+ | Efunc _ -> failwith "compile_expr : Unreachable matching"
+ | Eclos (fname, vars) ->
+ let i = ref 0
+ in
+ (malloc ((List.length vars) + 1))
+ @
+ (List.fold_left (fun base ident ->
+ incr i;
+ base
+ @
+ (ident_to_reg env ident A0)
+ @
+ [Lw (A0, (4 * !i, V0))])
+ [La (A0, fname) ;
+ Lw (A0, (0, V0))]
+ vars)
+and compile_letfuns env = function
+ | [] -> [], env
+ | (fname, fvars, farg, fbody)::l ->
+ let letfuns, env = (compile_letfuns env l)
+ in
+ [Label fname ;
+ Addi (SP, SP, -8) ;
+ Sw (RA, (4, SP)) ;
+ Sw (FP, (0, SP))]
+ @
+ (compile_expr env fbody)
+ @
+ [Lw (RA, (4, SP)) ;
+ Lw (FP, (0, SP)) ;
+ Jr RA]
+ @
+ letfuns, env
+
+let header_code =
+ print_int_code
+ @
+ [Label "main" ;
+ Addi (SP, SP, -(!frame_size)) ;
+ Addi (FP, SP, !frame_size - 4) ;
+ Move (T9, RA)]
+and footer_code =
+ [Move (RA, T9) ;
+ Addi (SP, SP, !frame_size) ;
+ Jr (RA)]
+
+let base_env =
+ { empty_env with addrs = Smap.add "print_int"
+ (Alab "print_int")
+ Smap.empty }
let compile a ofile =
- let a2, letfuns = replace_funcs a
+ let a, letfuns = replace_funcs (optimize_ast a)
in
- let program = merge_programs (compile_letfuns letfuns)
- (compile_expr a2)
- and f = open_out ofile
+ let compiled_letfuns, env = compile_letfuns base_env letfuns
in
- let fmt = formatter_of_out_channel f in
+ let instructions = header_code
+ @ (compile_expr env a)
+ @ footer_code
+ and f = open_out ofile
in
- format_program fmt program;
- close_out f
+ let program = optimize_program (filter_program instructions)
+ and fmt = formatter_of_out_channel f
+ in
+ format_program fmt program;
+ fprintf fmt "@?";
+ close_out f