(* Production de code pour le langage Arith *)

open Format
open Mips
open Ast

(* Exception à lever quand une variable (locale ou globale) est mal utilisée *)
exception VarUndef of string

(* Taille de la frame, en octets (chaque variable locale occupe 4 octets) *)
let frame_size = ref 0

(* Les variables globales sont stockées dans une table de hachage *)
let (genv : (string, unit) Hashtbl.t) = Hashtbl.create 17 

(* On utilise une table d'association dont les clés sont les variables locales
   (des chaînes de caractères) et où la valeur associée est la position
   par rapport à $fp (en octets) *)
module StrMap = Map.Make(String)

let push = Arith (Mips.Sub, SP, SP, Oimm 4)
let pop = Arith (Mips.Add, SP, SP, Oimm 4)

(* Compilation d'une expression *)        
let compile_expr = 
  (* Fonction récursive locale à compile_expr utilisée pour générer le code 
     machine de l'arbre de syntaxe abstraite associé à une valeur de type 
     Ast.expr ; à l'issue de l'exécution de ce code, la valeur doit se trouver
     en sommet de pile *)
  let rec comprec env fp = function
    | Cst i -> 
        [push; 
         Li (A0, i); 
         Sw (A0, Areg (0, SP))]
    | Var x -> 
        begin
          try
            let fp = StrMap.find x env in
            [push;
             Lw (A0, Areg (-fp, FP));
             Sw (A0, Areg (0, SP))]
          with Not_found ->
            if not (Hashtbl.mem genv x) then raise (VarUndef x);
            [push;
             Lw (A0, Alab x);
             Sw (A0, Areg (0, SP))]
        end
    | Binop (o,e1,e2)-> 
        let op = match o with
          | Add -> Mips.Add
          | Sub -> Mips.Sub
          | Mul -> Mips.Mul
          | Div -> Mips.Div
        in
        let code_e1 = comprec env fp e1 in
        let code_e2 = comprec env fp e2 in
        code_e1 @ code_e2 @ 
        [Lw (A0, Areg (4, SP)); 
         Lw (A1, Areg (0, SP)); 
         pop; 
         Arith (op, A0, A0, Oreg A1);
         Sw (A0, Areg (0, SP))]
    | Letin(x,e1,e2) -> 
        if !frame_size = fp then frame_size := 4 + !frame_size;
        let code_e1 = comprec env fp e1 in
        let code_e2 = comprec (StrMap.add x fp env) (fp+4) e2 in
        code_e1 @ 
        [Lw (A0, Areg (0, SP)); 
         pop;
         Sw (A0, Areg (-fp, FP))] @ 
        code_e2
  in 
  comprec StrMap.empty 0

(* Compilation d'une instruction *)            
let compile_instr = function
  | Set (x, e) -> 
      let code = 
        compile_expr e @ 
        [Lw (A0, Areg (0, SP));
         pop;
         Sw (A0, Alab x)] 
      in
      Hashtbl.replace genv x ();
      code
  | Print e -> 
      compile_expr e @ 
      [Lw (A0, Areg (0, SP)); 
       pop; 
       Jal "print"]


(* Compile le programme p et enregistre le code dans le fichier ofile *)
let compile_program p ofile =
  let code = List.map compile_instr p in
  let code = List.concat code in
  (* On ajoute la sauvegarde de $ra et le code de print *)
  let p = 
    { text = 
        [Label "main";
         Move (S0, RA); (* sauvegarde de $ra *)
         Arith (Mips.Sub, SP, SP, Oimm !frame_size); (* alloue la frame *)
         Arith (Mips.Add, FP, SP, Oimm (!frame_size - 4)); (* $fp = ... *)
        ] @ 
        code @
        [Arith (Mips.Add, SP, SP, Oimm !frame_size); (* désalloue la frame *)
         Move (RA, S0); (* restaure $ra *)
         Jr RA;
         Label "print";
         Li (V0, 1);
         Syscall;
         Li (V0, 4);
         La (A0, "newline");
         Syscall;
         Jr RA;
        ];
      data = 
        Hashtbl.fold (fun x _ l -> Word (x, 1) :: l) genv 
          [Asciiz ("newline", "\n")]
    }
  in
  let f = open_out ofile in 
  let fmt = formatter_of_out_channel f in
  Mips.print_program fmt p;
  (* on "flush" le buffer afin de s'assurer que tout y a été écrit
     avant de le fermer *)
  fprintf fmt "@?"; 
  close_out f

This document was generated using caml2html