open Misc open Gen open Code open Ass (************************************) (* Définition des registres du mips *) (************************************) (* 32 registres *) let n_real_regs = 32 let r = Array.sub registers 0 n_real_regs (* Dont voici les noms *) let zero, at, v0, v1, a0, a1, a2, a3 = r.(0), r.(1), r.(2), r.(3), r.(4), r.(5), r.(6), r.(7) let t0, t1, t2, t3, t4, t5, t6, t7 = r.(8), r.(9), r.(10), r.(11), r.(12), r.(13), r.(14), r.(15) let s0, s1, s2, s3, s4, s5, s6, s7 = r.(16), r.(17), r.(18), r.(19), r.(20), r.(21), r.(22), r.(23) let t8, t9, k0, k1, gp, sp, fp, ra = r.(24), r.(25), r.(26), r.(27), r.(28), r.(29), r.(30), r.(31) (* Vision des registres par l'assembleur *) let name_of_register = [| "zero"; "at"; "v0"; "v1"; "a0"; "a1"; "a2"; "a3"; "t0"; "t1"; "t2"; "t3"; "t4"; "t5"; "t6"; "t7"; "s0"; "s1"; "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "t8"; "t9"; "k0"; "k1"; "gp"; "sp"; "fp"; "ra"; |] let namer r = try "$"^name_of_register.(Gen.temp_int r) with Invalid_argument _ -> "$"^Ass.namer r (* Vérification de cohérence avec Frame *) let _ = assert (gp = Frame.global_register) (***********************************************************) (* Répartition des registres machine en diverse catégories *) (***********************************************************) (* Diverses catégories de registres exclus de l'allocation *) let special_registers = [fp; gp; sp; zero] let unused_registers = [at; v1; k0; k1;] let transfert_registers = [t8 ; t9] (* Répartition des registres à allouer. Noter que cette répartition dépend d'une option du compilateur *) (* Les arguments *) let arg_registers = match !Misc.nregs with | 3|4 -> [a0] | 5 -> [a0 ; a1] | _ -> [a0; a1; a2; a3] (* Le résultat *) let res_registers = [v0;] (* Caller/Callee saves *) let caller_save_registers = match !Misc.nregs with | (3|4) -> [] | 5 -> [t0] | _ -> [t0; t1; t2; t3; t4; t5; t6; t7; t8; t9] let callee_save_registers = match !Misc.nregs with | 3 -> [] | 4 -> [s0] | 5 -> [] | _ -> [s0; s1; s2; s3; s4; s5; s6; s7] (* Tous les registres pouvant être alloués *) let registers = ra :: List.concat [ caller_save_registers; arg_registers; res_registers; callee_save_registers; ];; (* Détruits par un appel de fonction *) let call_trash = ra :: List.concat [ caller_save_registers; arg_registers; res_registers; ] (* Gagne petit : les primitives ne détruisent pas tous les call_trash *) let trash f = if f = Frame.writeln_int || f = Frame.alloc then [ra; a0; v0] else if f = Frame.write_int || f = Frame.read_int then [ra; v0] else call_trash (*******************************************) (* Émission des instruction avec une table *) (* (module Table) *) (*******************************************) (* instruction qui ne fait rien *) let nop = Oper ("nop",[],[],None) let table = Table.create nop let emit ins = Table.emit table ins (***************) (* Utilitaires *) (***************) let seize_bits i = -(1 lsl 15) <= i && i < (1 lsl 15) let memo_of_op = function | Plus -> "add " | Uplus -> "addu" | Minus -> "sub " | Times -> "mul " | Div -> "div " | Lt -> "slt " | Le -> "sle " | Gt -> "sgt " | Ge -> "sge " | Eq -> "seq " | Ne -> "sne " exception No_commute let do_commute = function | Uplus -> Uplus | Plus -> Plus | Times -> Times | Lt -> Gt | Le -> Ge | Gt -> Lt | Ge -> Le | Eq -> Eq | Ne -> Ne | _ -> raise No_commute let is_commute op = try let _ = do_commute op in true with No_commute -> false (*****************************************) (* Emission d'instructions particulières *) (*****************************************) (* Les transferts de registre à registre *) let emit_move d s = if d <> s then emit (Move ("move ^d0, ^s0", s, d)) let emit_moves ds ss = List.iter2 emit_move ds ss (* Opération à seconde source entière *) let emit_op2 op d s i = emit (Oper (memo_of_op op^" ^d0, ^s0, "^string_of_int i, [s], [d], None)) (* Opération « trois-registres » *) let emit_op3 op d s0 s1 = emit (Oper (memo_of_op op^" ^d0, ^s0, ^s1", [s0 ; s1], [d], None)) (* Autres fonction d'emissions *) let emit_lw d i s = emit (Oper ("lw ^d0,"^string_of_int i^"(^s0)", [s], [d], None)) (*******************) (* Les expressions *) (*******************) (* emit_exp e - e est une expression * Le code est émis et un temporaire est renvoyé *) exception PasFini let rec emit_exp = function | Temp t -> t | Name l -> let d = new_temp () in emit (Oper ("la ^d0, " ^label_string l, [], [d], None)) ; d | Const 0 -> zero (* optimisation tres mipsienne *) | Const n -> let d = new_temp () and si = string_of_int n in emit (Oper ("li ^d0, " ^si, [], [d], None)) ; d | Bin (op, e1, Const n) when seize_bits n -> let s1 = emit_exp e1 and d = new_temp () in emit_op2 op d s1 n ; d | Bin (op, Const n, e2) when is_commute op && seize_bits n -> let s1 = emit_exp e2 and d = new_temp () in emit_op2 (do_commute op) d s1 n ; d | Bin (op, e1, e2) -> let s1 = emit_exp e1 and s2 = emit_exp e2 and d = new_temp () in emit_op3 op d s1 s2 ; d | Mem (Bin ((Plus|Uplus), Const n, e)) | Mem (Bin ((Plus|Uplus), e, Const n)) when seize_bits n -> let d = new_temp () and s = emit_exp e in emit_lw d n s ; d | Mem (Bin (Minus, e, Const n)) when seize_bits (-n) -> let d = new_temp () and s = emit_exp e in emit_lw d (-n) s ; d | Mem e -> let d = new_temp () and s = emit_exp e in emit_lw d 0 s ; d | Call (_,_) -> assert false (* le code est canonique *) (************************************) (* Les fonctions, pas mal de boulot *) (************************************) (* Registres détruits par un appel de fonction *) let call_trash = ra::caller_save_registers@arg_registers@res_registers (* Gagne petit : les primitives ne détruisent pas tous les call_trash *) let trash f = if f = Frame.writeln_int || f = Frame.alloc then [ra; a0; v0] else if f = Frame.write_int || f = Frame.read_int then [ra; v0] else call_trash (* Emit jal instruction, sources are exact, while destinations are approximated *) let rec nfirsts n rs = if n = 0 then [] else match rs with | [] -> [] | r::rs -> r::nfirsts (n-1) rs let emit_jal f = let srcs = nfirsts (List.length (Frame.frame_args f)) arg_registers and dests = trash f in emit (Oper ("jal "^Gen.label_string (Frame.frame_name f), dests, srcs, None)) let rec emit_args regs args = match regs, args with | r::rs, e::es -> let s = emit_exp e in emit_move r s ; emit_args rs es | _, [] -> () | [], _ -> assert false (* Par hypothèse *) let emit_call caller_frame callee_frame args = emit_args arg_registers args ; emit_jal callee_frame ; v0 (********************) (* Les instructions *) (********************) let emit_label l = emit (Label (Gen.label_string l^":",l)) let emit_branch l = emit (Oper ("b "^Gen.label_string l, [], [], Some [l])) let branch_of_relop = function | Req -> "beq" | Rne -> "bne" | Rle -> "ble" | Rge -> "bge" | Rlt -> "blt" | Rgt -> "bgt" let emit_bcc op s0 s1 lab1 lab2 = emit (Oper (branch_of_relop op^" ^s0, ^s1, "^Gen.label_string lab1, [s0 ; s1], [], Some [lab1 ; lab2])) let emit_sw s0 i s1 = emit (Oper ("sw ^s0,"^string_of_int i^"(^s1)", [s0 ; s1], [], None)) let emit_stm frame = function | Code.Label lab -> emit_label lab | Jump lab -> emit_branch lab | Cjump (op, e1, e2, lab1, lab2) -> let s1 = emit_exp e1 and s2 = emit_exp e2 in emit_bcc op s1 s2 lab1 lab2 | Move_temp (d, Call (f,args)) -> let r = emit_call frame f args in emit_move d r | Move_temp (d, e) -> let s = emit_exp e in emit_move d s | Move_mem ((Bin ((Plus|Uplus), Const n, ea)|Bin ((Plus|Uplus), ea, Const n)), e) when seize_bits n -> let s0 = emit_exp ea and s1 = emit_exp e in emit_sw s1 n s0 | Move_mem (Bin (Minus, ea, Const n), e) when seize_bits (-n) -> let s0 = emit_exp ea and s1 = emit_exp e in emit_sw s1 (-n) s0 | Move_mem(ea, e) -> let s0 = emit_exp ea and s1 = emit_exp e in emit_sw s1 0 s0 | Exp (Call (f,args)) -> ignore (emit_call frame f args) | Exp e -> ignore (emit_exp e) | Seq _ -> assert false (*********************) (* Prologue/Épilogue *) (*********************) (* NB: on suppose le passage en registre de tous les arguments *) let emit_prolog f decr_sp = (* Émission du point d'entrée *) emit_label (Frame.frame_name f) ; (* Allouer le frame en décrémentant sp *) emit (Oper (decr_sp, [], [], None)) ; (* Sauvegarder les callee_save *) let saved_callee_save = Gen.new_temp ():: List.map (fun _ -> Gen.new_temp ()) callee_save_registers in emit_moves saved_callee_save (ra::callee_save_registers) ; (* Copier les arguments des registres conventionnels vers les temporaires idoines *) let rec get_args temps regs = match temps, regs with | t::ts, r::rs -> emit_move t r ; get_args ts rs | [],_ -> () | _,[] -> failwith (Printf.sprintf "Plus de %i arguments" (List.length arg_registers)) in get_args (Frame.frame_args f) arg_registers ; (* Finalement renvoyer les sauvegardes des callee-saves *) saved_callee_save let emit_postlog f saved_regs incr_sp = (* Emission du point d'entrée *) emit_label (Frame.frame_return f) ; (* Transfert du resultat du temporaire idoine vers le registre conventionel *) begin match (Frame.frame_result f) with | None -> () | Some s -> emit_move v0 s end ; (* Restaurer les callee-saves *) emit_moves (ra::callee_save_registers) saved_regs ; (* Desallouer le frame (incrémenter sp) *) emit (Oper (incr_sp, [], [], None)) ; (* Émettre l'instruction de retour *) let survivants = match (Frame.frame_result f) with | None -> callee_save_registers | Some _ -> v0::callee_save_registers in emit (Oper ("j ^s0", ra::survivants, [], Some [])) type procedure = { frame : Frame.frame ; (* Voir frame.mli *) code : Ass.instr list ; (* Code proprement dit *) remove_ifzero : string list ; } let emit_fun f is = (* temporaires pour sauver les callee_save *) let frame_size = Frame.frame_size_label f in let decr_sp = "subu $sp, $sp, "^frame_size and incr_sp = "addu $sp, $sp, "^frame_size in (* Le prologue *) let saved_callee_save = emit_prolog f decr_sp in (* code proprement dit *) List.iter (fun i -> emit_stm f i) is ; (* L'épilogue *) emit_postlog f saved_callee_save incr_sp ; (* Renvoyer le code *) {frame=f ; remove_ifzero = [incr_sp ; decr_sp] ; code = Table.trim_to_list table ; } (* Le prologue du programme et son code de lancement *) let taille_memoire = 4000 let align_word = string_of_int (match Frame.wordsize with 1 -> 0 | 2 -> 1 | 4 -> 2 | 8 -> 3 | _ -> assert false);; let prelude glob lab = Oper (String.concat "" [" .data nl: .asciiz \"\\n\" .align "; align_word; " allocs: .asciiz \"Alloc: \" .align "; align_word; " Glob: .space "; string_of_int (glob * Frame.wordsize); " .align "; align_word; " Mem: .space "; string_of_int (taille_memoire * Frame.wordsize); " .text .globl __start .align "; align_word; " print_int: li $v0, 1 syscall j $ra println_int: li $v0, 1 syscall la $a0, nl li $v0, 4 syscall j $ra read_int: li $v0, 5 syscall j $ra alloc: sw $a0, ($fp) sll $a0, $a0, 2 addu $v0, $fp, 4 addu $fp, $v0, $a0 j $ra __start: la $fp, Mem la $gp, Glob jal "; Gen.label_string lab; " li $v0, 10 syscall "], [], [], Some []) ;; type program = { prelude : instr; main : procedure; procedures : procedure list; } let program p = let main_f,main_code = p.Trans.main in { prelude = prelude p.Trans.number_of_globals (Frame.frame_name main_f) ; main = emit_fun main_f main_code ; procedures = List.map (fun (f,code) -> emit_fun f code) p.Trans.procedures } let load_sp u i u' = Ass.Oper ("lw ^d0, "^(string_of_int i)^"($sp) # load "^namer u, [], [u'], None) let save_sp u i u' = Ass.Oper ("sw ^s0, "^(string_of_int i)^"($sp) # store "^namer u, [u'], [], None) let move s d = Move ("move ^d0, ^s0",s,d)