Interprétation et compilation

HN \Rightarrow Lien (il y a ça aussi)
Site du prof
Exemples d’implémentation/inspiration pour le projet final :

Mini tuto pour configurer VSCode et OCaml

Tuto Menhir

Cheat sheet MIPS

Liste des cours

Intro

Example d’interpréteur en OCaml

let eval expr =
  let lst = String.split_on_char ' ' expr in
  let cmd = List.hd lst in (* hd = head *) 
  let args = List.map int_of_string (List.tl lst) in
  match cmd with
  | "num" -> Some (List.hd args)
  | "add" -> Some ((List.nth args 0) + (List.nth args 1))
  | "exit" -> None
  | _ -> 
	 Printf.eprintf "Error: unknown command '%s' \n" cmd ;
	 None

let rec repl invite = 
  print_string invite ;
  match read_line () |> eval_with
  | Some n -> Printf.printf "%d\n" n ;
			  repl invite
  | None   -> Printf.eprintf "Bye.\n"

let () = repl "> "

Example d’une implémentation de map en OCaml

let rec_map f l =
  match l with
  | [] -> []
  (* tl = tail *)
  | hd :: tl -> (f hd) :: (map f tl)

ratio

exception UnknownCmd of string

let to_python expr =
  let lst = String.split on_char ' ' expr in
  let cmd = List.hd lst in
  let args = List.map int_of_string (List.tl lst) in
  match cmd with
  | "num"  -> Printf.sprintf "print(%d)" (List.hd args)
  | "add"  -> Printf.sprintf "print(%d)" ((List.hd args) + (List.nth args 1))
  | "exit" -> Printf.sprintf "exit(1)"
  | _      -> raise (UnknownCmd)

let compile ic_oc =
  let rec comp l =
    try
      let expr = input_line ic in
      Printf.fprintf oc "%s\n" (to_python expr) ;
      comp (l + 1)
    with
    | End_of_file  -> ()
    | UnknownCmd c -> (* J'ai pas fini de recopié RIP x( *)

Projet marrant qui partent de NAND pour faire quelque chose de plus cool :

Utiliser son language comme compilateur du language ça permet de manger sa propore merde

Chapitre 1

Trucs sympa :

Mirage
Erlang

Type	Opérateurs
Listes	`@`
Chaînes de caractères	`^`
Paire	`*`
Pointeur	`!`

Example de type avec implantation d’une liste

type 'a mylist =
  | Vide
  | Cons of 'a * 'a mylist

Cons (2, Cons (3, Vide))

Exemple de gardien

let parity = function
  | 0 -> "pair"
  | 1 -> "impair"
  | 2 -> "pair"
  | 3 -> "impair"
  | _ as n when (n mod 2 = 0) -> "pair" (* Guard *)
  | _ -> "impair"

Chapitre 2 - MISP

On utilises pas le registre $at parcqu’il est réservé par l’assembleur, $gp non-plus car il permet de savoir où se trouve le pointeur.
Registre temporaire : on est pas sûr de ce qu’il y a dedans si on appelle une fonction entre 2 instructions
Adresse de retour : permet de savoir où on était dans le code lors d’une appelle de fonction, pour savoir où aller à la fin de cette dernière.

Registre $pc : program counter

On utilises SPIM pour débogguer nos fichiers .ASM.

Spim
```
$ spim
$ read machin.s
$ s
# maintenant à chaque fois qu'on fait [Entrée] ça passe à l'instruction suivante
```

Dans ce cours on commence la compilation

ast.ml

module IR = struct
  type value =
    | Void
    | Bool of bool
    | Int of int
    | Data of string

  type expr =
    | Value of value
    | Var of string
    | Call of string * expr list

  type instr =
    | Decl of string
    | Assign of string * expr
    | Do of expr (* appel de fonction void *)
    | Return of expr

  type def = Func of string * string list * instr list
  type prog = def list
end

module MIPS = struct
  type reg =
    | Zero
    | SP
    | FP
    | RA
    | V0
    | A0
    | A1
    | T0
    | T1
    | T2

  type label = string

  type loc =
    | Lbl of label
    | Reg of reg
    | Mem of reg * int

  type instr =
    | Label of label
    | Li of reg * int
    | La of reg * loc
    | Sw of reg * loc
    | Lw of reg * loc
    | Sb of reg * loc
    | Lb of reg * loc
    | Move of reg * reg
    | Addi of reg * reg * int
    | Add of reg * reg * reg
    | Mul of reg * reg * reg
    | Syscall
    | B of label
    | Beq of reg * reg * label
    | Bne of reg * reg * label
    | Jal of label
    | Jr of reg

  type directive = Asciiz of string
  type decl = label * directive

  type asm =
    { text : instr list
    ; data : decl list
    }

  module Syscall = struct
    let print_int = 1
    let print_str = 4
    let read_int = 5
    let read_str = 8
  end
end

baselib.ml

open Ast.MIPS
module Env = Map.Make (String)

let _baselib_ =
  [ Label "_add"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Add (V0, T0, T1)
  ; Jr RA
  ; Label "_mul"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Mul (V0, T0, T1)
  ; Jr RA
  ; Label "puti"
  ; Lw (A0, Mem (SP, 0))
  ; Li (V0, Syscall.print_int)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
(*   ; Label "puts"
  ; print_string *)
  ; Label "pnl" (* print newline *)
  ; La (A0, Lbl "qlf")
  ; Li (V0, Syscall.print_str)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
  ]
;;

compiler.ml

open Ast.IR
open Ast.MIPS
open Baselib

let compile_value = function
  | Void -> [ Li (V0, 0) ]
  | Bool b -> [ Li (V0, if b then 1 else 0) ]
  | Int n -> [ Li (V0, n) ]
  | Data d -> []
;;

let rec compile_expr e env =
  let compile_on_push e =
    (* -4 à chaque argument *)
    compile_expr e env @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ]
  in
  match e with
  | Value v -> compile_value v
  | Var v -> [ Lw (V0, Env.find v env) ]
  | Call (f, args) ->
    let compile_args = List.map compile_on_push args in
    (* +4 à chaque argument *)
    List.flatten compile_args @ [ Jal f; Addi (SP, SP, 4 * List.length args) ]
;;

type info =
  { asm : instr list
  ; env : loc Env.t
  ; fpo : int (* FP offset *)
  }

let compile_instr i info =
  match i with
  | Decl v ->
    { info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
  | Assign (v, e) ->
    { info with
      asm = info.asm @ compile_expr e info.env @ [ Sw (V0, Env.find v info.env) ]
    }
  | Do e -> { info with asm = info.asm @ compile_expr e info.env }
  | Return e ->
    { info with
      asm =
        info.asm
        @ compile_expr e info.env
        @ [ Lw (RA, Mem (FP, 0)); Addi (SP, FP, 4); Lw (FP, Mem (FP, -4)); Jr RA ]
    }
;;

let rec compile_block b info =
  match b with
  | [] -> info
  | i :: b -> compile_block b (compile_instr i info)
;;

let compile_def (Func (name, args, body)) =
  let compile_body =
    compile_block
      body
      { asm = []
      ; env =
          List.fold_left
            (fun env (arg, addr) -> Env.add arg addr env)
            Env.empty
            (List.mapi (fun i a -> a, Mem (FP, 4 * (i + 1))) (List.rev args))
      ; fpo = 8
      }
  in
  [ Label name
  ; Addi (SP, SP, -compile_body.fpo)
  ; Sw (RA, Mem (SP, 4))
  ; Sw (FP, Mem (SP, 0))
  ; Addi (FP, SP, 4)
  ]
  @ compile_body.asm
  @ [ Li (V0, 0); Lw (RA, Mem (FP, 0)); Addi (SP, FP, 4); Lw (FP, Mem (FP, -4)); Jr RA ]
;;

let compile ir =
  let asm = List.flatten (List.map compile_def ir) in
  { text = _baselib_ @ asm; data = [ "qlf", Asciiz "\\n" ] }
;;

mips.ml

open Ast.MIPS

let ps = Printf.sprintf (* alias raccourci *)

let fmt_reg = function
  | Zero -> "$zero"
  | SP -> "$sp"
  | FP -> "$fp"
  | RA -> "$ra"
  | V0 -> "$v0"
  | A0 -> "$a0"
  | A1 -> "$a1"
  | T0 -> "$t0"
  | T1 -> "$t1"
  | T2 -> "$t2"
;;

let fmt_loc = function
  | Lbl l -> l
  | Reg r -> fmt_reg r
  | Mem (r, o) -> ps "%d(%s)" o (fmt_reg r)
;;

let fmt_instr = function
  | Label l -> ps "%s:" l
  | Li (r, i) -> ps " li %s, %d" (fmt_reg r) i
  | La (r, a) -> ps " la %s, %s" (fmt_reg r) (fmt_loc a)
  | Sw (r, a) -> ps " sw %s, %s" (fmt_reg r) (fmt_loc a)
  | Lw (r, a) -> ps " lw %s, %s" (fmt_reg r) (fmt_loc a)
  | Sb (r, a) -> ps " sb %s, %s" (fmt_reg r) (fmt_loc a)
  | Lb (r, a) -> ps " lb %s, %s" (fmt_reg r) (fmt_loc a)
  | Move (rd, rs) -> ps " move %s, %s" (fmt_reg rd) (fmt_reg rs)
  | Addi (rd, rs, i) -> ps " addi %s, %s, %d" (fmt_reg rd) (fmt_reg rs) i
  | Add (rd, rs, rt) -> ps " add %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Mul (rd, rs, rt) -> ps " mul %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Syscall -> ps " syscall"
  | B l -> ps " b %s" l
  | Beq (rs, rt, l) -> ps " beq %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Bne (rs, rt, l) -> ps " bne %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Jal l -> ps " jal %s" l
  | Jr r -> ps " jr %s" (fmt_reg r)
;;

let fmt_dir = function
  | Asciiz s -> ps ".asciiz \"%s\"" s
;;

let print_asm oc asm =
  Printf.fprintf oc ".text\n.globl main\n";
  List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text;
  Printf.fprintf oc "\n.data\n";
  List.iter (fun (l, d) -> Printf.fprintf oc "%s: %s\n" l (fmt_dir d)) asm.data
;;

test.ml

open Ast

let () =
  let ir =
    [ IR.Func ("main", [], [Decl "a"
    ; Assign ("a", Value (Int 42))
    ; Decl "toto"
    ; Assign ("toto", Call ("_add", [ Var "a"; Value (Int 9) ]))
    ; Do (Call ("puti", [ Var "toto" ]))
    ; Do (Call ("pnl", []))
    ; Return (Var "a")])
    ]
  in
  let asm = Compiler.compile ir in
  Mips.print_asm Stdlib.stdout asm
;;

Dans ce cours on ajoute la gestion des strings

ast.ml

(* Ça c'est un type de module qui DOIT
 * implémenter un type value, sig = signature *)
module type Param = sig
  type value
end

(* Value1 *)
module V1 = struct
  type value =
    | Void
    | Bool of bool
    | Int of int
    | Str of string
end

(* Value2 *)
module V2 = struct
  type value =
    | Void
    | Bool of bool
    | Int of int
    | Data of string
end

(* Le module IR prend
 * un Paramètre en argument *)
module IR (P : Param) = struct
  (* Ici, value est définie via P *)

  type expr =
    | Value of P.value
    | Var of string
    | Call of string * expr list

  type instr =
    | Decl of string
    | Assign of string * expr
    | Do of expr (* appel de fonction void *)
    | Return of expr

  type def = Func of string * string list * instr list
  type prog = def list
end

module IR1 = IR (V1)
module IR2 = IR (V2)

module MIPS = struct
  type reg =
    | Zero
    | SP
    | FP
    | RA
    | V0
    | A0
    | A1
    | T0
    | T1
    | T2

  type label = string

  type loc =
    | Lbl of label
    | Reg of reg
    | Mem of reg * int

  type instr =
    | Label of label
    | Li of reg * int
    | La of reg * loc
    | Sw of reg * loc
    | Lw of reg * loc
    | Sb of reg * loc
    | Lb of reg * loc
    | Move of reg * reg
    | Addi of reg * reg * int
    | Add of reg * reg * reg
    | Mul of reg * reg * reg
    | Syscall
    | B of label
    | Beq of reg * reg * label
    | Bne of reg * reg * label
    | Jal of label
    | Jr of reg

  type directive = Asciiz of string
  type decl = label * directive

  type asm =
    { text : instr list
    ; data : decl list
    }

  module Syscall = struct
    let print_int = 1
    let print_str = 4
    let read_int = 5
    let read_str = 8
  end
end

baselib.ml

open Ast.MIPS
module Env = Map.Make (String)

let _baselib_ =
  [ Label "_add"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Add (V0, T0, T1)
  ; Jr RA
  ; Label "_mul"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Mul (V0, T0, T1)
  ; Jr RA
  ; Label "puti"
  ; Lw (A0, Mem (SP, 0))
  ; Li (V0, Syscall.print_int)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
(*   ; Label "puts"
  ; print_string *)
  ; Label "pnl" (* print newline *)
  ; La (A0, Lbl "qlf")
  ; Li (V0, Syscall.print_str)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
  ]
;;

compiler.ml

open Ast.IR2
open Ast.V2
open Ast.MIPS
open Baselib

let compile_value = function
  | Void -> [ Li (V0, 0) ]
  | Bool b -> [ Li (V0, if b then 1 else 0) ]
  | Int n -> [ Li (V0, n) ]
  | Data l -> [ La (V0, Lbl l) ]
;;

let rec compile_expr e env =
  let compile_on_push e =
    (* -4 à chaque argument *)
    compile_expr e env @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ]
  in
  match e with
  | Value v -> compile_value v
  | Var v -> [ Lw (V0, Env.find v env) ]
  | Call (f, args) ->
    let compile_args = List.map compile_on_push args in
    (* +4 à chaque argument *)
    List.flatten compile_args @ [ Jal f; Addi (SP, SP, 4 * List.length args) ]
;;

type info =
  { asm : instr list
  ; env : loc Env.t
  ; fpo : int (* FP offset *)
  }

let compile_instr i info =
  match i with
  | Decl v ->
    { info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
  | Assign (v, e) ->
    { info with
      asm = info.asm @ compile_expr e info.env @ [ Sw (V0, Env.find v info.env) ]
    }
  | Do e -> { info with asm = info.asm @ compile_expr e info.env }
  | Return e ->
    { info with
      asm =
        info.asm
        @ compile_expr e info.env
        @ [ Lw (RA, Mem (FP, 0)); Addi (SP, FP, 4); Lw (FP, Mem (FP, -4)); Jr RA ]
    }
;;

let rec compile_block b info =
  match b with
  | [] -> info
  | i :: b -> compile_block b (compile_instr i info)
;;

let compile_def (Func (name, args, body)) =
  let compile_body =
    compile_block
      body
      { asm = []
      ; env =
          List.fold_left
            (fun env (arg, addr) -> Env.add arg addr env)
            Env.empty
            (List.mapi (fun i a -> a, Mem (FP, 4 * (i + 1))) (List.rev args))
      ; fpo = 8
      }
  in
  [ Label name
  ; Addi (SP, SP, -compile_body.fpo)
  ; Sw (RA, Mem (SP, 4))
  ; Sw (FP, Mem (SP, 0))
  ; Addi (FP, SP, 4)
  ]
  @ compile_body.asm
  @ [ Li (V0, 0); Lw (RA, Mem (FP, 0)); Addi (SP, FP, 4); Lw (FP, Mem (FP, -4)); Jr RA ]
;;

let compile (ir2, cs) =
  let asm = List.flatten (List.map compile_def ir2) in
  { text = _baselib_ @ asm; data = [ "qlf", Asciiz "\\n" ] @ cs }
;;

mips.ml

open Ast.MIPS

let ps = Printf.sprintf (* alias raccourci *)

let fmt_reg = function
  | Zero -> "$zero"
  | SP -> "$sp"
  | FP -> "$fp"
  | RA -> "$ra"
  | V0 -> "$v0"
  | A0 -> "$a0"
  | A1 -> "$a1"
  | T0 -> "$t0"
  | T1 -> "$t1"
  | T2 -> "$t2"
;;

let fmt_loc = function
  | Lbl l -> l
  | Reg r -> fmt_reg r
  | Mem (r, o) -> ps "%d(%s)" o (fmt_reg r)
;;

let fmt_instr = function
  | Label l -> ps "%s:" l
  | Li (r, i) -> ps " li %s, %d" (fmt_reg r) i
  | La (r, a) -> ps " la %s, %s" (fmt_reg r) (fmt_loc a)
  | Sw (r, a) -> ps " sw %s, %s" (fmt_reg r) (fmt_loc a)
  | Lw (r, a) -> ps " lw %s, %s" (fmt_reg r) (fmt_loc a)
  | Sb (r, a) -> ps " sb %s, %s" (fmt_reg r) (fmt_loc a)
  | Lb (r, a) -> ps " lb %s, %s" (fmt_reg r) (fmt_loc a)
  | Move (rd, rs) -> ps " move %s, %s" (fmt_reg rd) (fmt_reg rs)
  | Addi (rd, rs, i) -> ps " addi %s, %s, %d" (fmt_reg rd) (fmt_reg rs) i
  | Add (rd, rs, rt) -> ps " add %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Mul (rd, rs, rt) -> ps " mul %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Syscall -> ps " syscall"
  | B l -> ps " b %s" l
  | Beq (rs, rt, l) -> ps " beq %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Bne (rs, rt, l) -> ps " bne %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Jal l -> ps " jal %s" l
  | Jr r -> ps " jr %s" (fmt_reg r)
;;

let fmt_dir = function
  | Asciiz s -> ps ".asciiz \"%s\"" s
;;

let print_asm oc asm =
  Printf.fprintf oc ".text\n.globl main\n";
  List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text;
  Printf.fprintf oc "\n.data\n";
  List.iter (fun (l, d) -> Printf.fprintf oc "%s: %s\n" l (fmt_dir d)) asm.data
;;

simplifier.ml

open Ast

let collect_constant_strings code =
  let counter = ref 0 in
  let ccs_value = function
    | V1.Void -> V2.Void, []
    | V1.Bool b -> V2.Bool b, []
    | V1.Int n -> V2.Int n, []
    | V1.Str s ->
      incr counter;
      let lbl = "str" ^ string_of_int !counter in
      V2.Data lbl, [ lbl, MIPS.Asciiz s ]
  in
  let rec ccs_expr = function
    | IR1.Value v ->
      let v2, cs = ccs_value v in
      IR2.Value v2, cs
    | IR1.Var v -> IR2.Var v, []
    | IR1.Call (fn, args) ->
      let a2 = List.map ccs_expr args in
      IR2.Call (fn, List.map fst a2), List.flatten (List.map snd a2)
  in
  let ccs_instr = function
    | IR1.Decl v -> IR2.Decl v, []
    | IR1.Assign (v, e) ->
      let e2, cs = ccs_expr e in
      IR2.Assign (v, e2), cs
    | IR1.Do e ->
      let e2, cs = ccs_expr e in
      IR2.Do e2, cs
    | IR1.Return e ->
      let e2, cs = ccs_expr e in
      IR2.Do e2, cs
  in
  let rec ccs_block acc_b acc_cs = function
    | i :: b ->
      let i2, cs = ccs_instr i in
      ccs_block (i2 :: acc_b) (cs @ acc_cs) b
    | [] -> List.rev acc_b, acc_cs
  in
  let ccs_def (IR1.Func (name, args, body)) =
    let body2, cs = ccs_block [] [] body in
    IR2.Func (name, args, body2), cs
  in
  let code2 = List.map ccs_def code in
  List.map fst code2, List.flatten (List.map snd code2)
;;

let simplify ir = collect_constant_strings ir

test.ml

open Ast
open Simplifier

let () =
  let ir =
    [ IR1.Func
        ( "main"
        , []
        , [ Decl "a"
          ; Assign ("a", Value (Int 42))
          ; Decl "toto"
          ; Assign ("toto", Call ("_add", [ Var "a"; Value (Int 9) ]))
          ; Do (Call ("puti", [ Var "toto" ]))
          ; Do (Call ("pnl", []))
          ; Return (Var "a")
          ] )
    ]
  in
  let asm = Compiler.compile (simplify ir) in
  Mips.print_asm Stdlib.stdout asm
;;

J’utilises le même Makefile que le cours d’avant (toujours aussi moche)

Makefile

main:
	clear
	ocamlopt *.ml
	rm *.o *.cmx *.out
	ocamlbuild -no-hygiene test.byte
	./test.byte > test.s
	spim -file test.s
	rm test.byte

Dans ce cours on ajoute la gestion des pointeurs

ast.ml

module type Param = sig
  type value
end

module V1 = struct
  type value =
    | Void
    | Bool of bool
    | Int of int
    | Str of string
    | Ptr of int
end

module V2 = struct
  type value =
    | Void
    | Bool of bool
    | Int of int
    | Data of string
    | Ptr of int
end

module IR (P : Param) = struct
  type expr =
    | Value of P.value
    | Var of string
    | Call of string * expr list

  type lval =
    | LName of string
    | LAddr of expr

  type instr =
    | Decl of string
    | Assign of lval * expr
    | Do of expr
    | Return of expr

  type def = Func of string * string list * instr list
  type prog = def list
end

module IR1 = IR (V1)
module IR2 = IR (V2)

module MIPS = struct
  type reg =
    | Zero
    | SP
    | FP
    | RA
    | V0
    | A0
    | A1
    | T0
    | T1
    | T2

  type label = string

  type loc =
    | Lbl of label
    | Reg of reg
    | Mem of reg * int

  type instr =
    | Label of label
    | Li of reg * int
    | La of reg * loc
    | Sw of reg * loc
    | Lw of reg * loc
    | Sb of reg * loc
    | Lb of reg * loc
    | Move of reg * reg
    | Addi of reg * reg * int
    | Add of reg * reg * reg
    | Mul of reg * reg * reg
    | Syscall
    | B of label
    | Beq of reg * reg * label
    | Bne of reg * reg * label
    | Jal of label
    | Jr of reg

  type directive = Asciiz of string
  type decl = label * directive

  type asm =
    { text : instr list
    ; data : decl list
    }

  module Syscall = struct
    let print_int = 1
    let print_str = 4
    let read_int = 5
    let read_str = 8
    let sbrk = 9
    let exit = 10
  end
end

baselib.ml

open Ast.MIPS
module Env = Map.Make (String)

let _baselib_ =
  [ Label "_add"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Add (V0, T0, T1)
  ; Jr RA
  ; Label "_mul"
  ; Lw (T0, Mem (SP, 4))
  ; Lw (T1, Mem (SP, 0))
  ; Mul (V0, T0, T1)
  ; Jr RA
  ; Label "puti"
  ; Lw (A0, Mem (SP, 0))
  ; Li (V0, Syscall.print_int)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
    (*   ; Label "puts"
  ; print_string *)
  ; Label "pnl" (* print newline *)
  ; La (A0, Lbl "qlf")
  ; Li (V0, Syscall.print_str)
  ; Syscall
  ; Li (V0, 0)
  ; Jr RA
  ; Label "alloc"
  ; Lw (A0, Mem (SP, 0))
  ; Li (V0, Syscall.sbrk)
  ; Syscall
  ; Jr RA
  ; Label "_deref"
  ; Lw (T0, Mem (SP, 0))
  ; Lw (V0, Mem (T0, 0))
  ; Jr RA
  ]
;;

compiler.ml, on a fixé compile_def donc faut bien faire gaffe attention !!

open Ast.IR2
open Ast.V2
open Ast.MIPS
open Baselib

let compile_value = function
  | Void -> [ Li (V0, 0) ]
  | Bool b -> [ Li (V0, if b then 1 else 0) ]
  | Int n -> [ Li (V0, n) ]
  | Ptr p -> [ Li (V0, p) ]
  | Data l -> [ La (V0, Lbl l) ]
;;

let rec compile_expr e env =
  let compile_on_push e =
    (* -4 à chaque argument *)
    compile_expr e env @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ]
  in
  match e with
  | Value v -> compile_value v
  | Var v -> [ Lw (V0, Env.find v env) ]
  | Call (f, args) ->
    let compile_args = List.map compile_on_push args in
    (* +4 à chaque argument *)
    List.flatten compile_args @ [ Jal f; Addi (SP, SP, 4 * List.length args) ]
;;

type info =
  { asm : instr list
  ; env : loc Env.t
  ; fpo : int (* FP offset *)
  }

let compile_instr i info =
  match i with
  | Decl v ->
    { info with env = Env.add v (Mem (FP, -info.fpo)) info.env; fpo = info.fpo + 4 }
  | Assign (lv, e) ->
    { info with
      asm =
        (info.asm
        @ compile_expr e info.env
        @
        match lv with
        | LName v -> [ Sw (V0, Env.find v info.env) ]
        | LAddr e ->
          [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ]
          @ compile_expr e info.env
          @ [ Lw (T0, Mem (SP, 0)); Addi (SP, SP, 4); Sw (T0, Mem (V0, 0)) ])
    }
  | Do e -> { info with asm = info.asm @ compile_expr e info.env }
  | Return e ->
    { info with
      asm =
        info.asm
        @ compile_expr e info.env
        @ [ Lw (RA, Mem (FP, 0)); Addi (SP, FP, 4); Lw (FP, Mem (FP, -4)); Jr RA ]
    }
;;

let rec compile_block b info =
  match b with
  | [] -> info
  | i :: b -> compile_block b (compile_instr i info)
;;

let compile_def (Func (name, args, body)) =
  let compile_body =
    compile_block
      body
      { asm = []
      ; env =
          List.fold_left
            (fun env (arg, addr) -> Env.add arg addr env)
            Env.empty
            (List.mapi (fun i a -> a, Mem (FP, 4 * (i + 1))) (List.rev args))
      ; fpo = 8
      }
  in
  [ Label name
  ; Addi (SP, SP, -compile_body.fpo)
  ; Sw (RA, Mem (SP, compile_body.fpo - 4))
  ; Sw (FP, Mem (SP, compile_body.fpo - 8))
  ; Addi (FP, SP, compile_body.fpo - 4)
  ]
  @ compile_body.asm
  @ [ Addi (SP, SP, compile_body.fpo)
    ; Lw (RA, Mem (FP, 0))
    ; Addi (SP, FP, 4)
    ; Lw (FP, Mem (FP, -4))
    ; Jr RA
    ]
;;

let compile (ir2, cs) =
  let asm = List.flatten (List.map compile_def ir2) in
  { text = _baselib_ @ asm; data = [ "qlf", Asciiz "\\n" ] @ cs }
;;

mips.ml

open Ast.MIPS

let ps = Printf.sprintf (* alias raccourci *)

let fmt_reg = function
  | Zero -> "$zero"
  | SP -> "$sp"
  | FP -> "$fp"
  | RA -> "$ra"
  | V0 -> "$v0"
  | A0 -> "$a0"
  | A1 -> "$a1"
  | T0 -> "$t0"
  | T1 -> "$t1"
  | T2 -> "$t2"
;;

let fmt_loc = function
  | Lbl l -> l
  | Reg r -> fmt_reg r
  | Mem (r, o) -> ps "%d(%s)" o (fmt_reg r)
;;

let fmt_instr = function
  | Label l -> ps "%s:" l
  | Li (r, i) -> ps " li %s, %d" (fmt_reg r) i
  | La (r, a) -> ps " la %s, %s" (fmt_reg r) (fmt_loc a)
  | Sw (r, a) -> ps " sw %s, %s" (fmt_reg r) (fmt_loc a)
  | Lw (r, a) -> ps " lw %s, %s" (fmt_reg r) (fmt_loc a)
  | Sb (r, a) -> ps " sb %s, %s" (fmt_reg r) (fmt_loc a)
  | Lb (r, a) -> ps " lb %s, %s" (fmt_reg r) (fmt_loc a)
  | Move (rd, rs) -> ps " move %s, %s" (fmt_reg rd) (fmt_reg rs)
  | Addi (rd, rs, i) -> ps " addi %s, %s, %d" (fmt_reg rd) (fmt_reg rs) i
  | Add (rd, rs, rt) -> ps " add %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Mul (rd, rs, rt) -> ps " mul %s, %s, %s" (fmt_reg rd) (fmt_reg rs) (fmt_reg rt)
  | Syscall -> ps " syscall"
  | B l -> ps " b %s" l
  | Beq (rs, rt, l) -> ps " beq %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Bne (rs, rt, l) -> ps " bne %s, %s, %s" (fmt_reg rs) (fmt_reg rt) l
  | Jal l -> ps " jal %s" l
  | Jr r -> ps " jr %s" (fmt_reg r)
;;

let fmt_dir = function
  | Asciiz s -> ps ".asciiz \"%s\"" s
;;

let print_asm oc asm =
  Printf.fprintf oc ".text\n.globl main\n";
  List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text;
  Printf.fprintf oc "\n.data\n";
  List.iter (fun (l, d) -> Printf.fprintf oc "%s: %s\n" l (fmt_dir d)) asm.data
;;

simplifier.ml

open Ast

let collect_constant_strings code =
  let counter = ref 0 in
  let ccs_value = function
    | V1.Void -> V2.Void, []
    | V1.Bool b -> V2.Bool b, []
    | V1.Int n -> V2.Int n, []
    | V1.Ptr p -> V2.Ptr p, []
    | V1.Str s ->
      incr counter;
      let lbl = "str" ^ string_of_int !counter in
      V2.Data lbl, [ lbl, MIPS.Asciiz s ]
  in
  let rec ccs_expr = function
    | IR1.Value v ->
      let v2, cs = ccs_value v in
      IR2.Value v2, cs
    | IR1.Var v -> IR2.Var v, []
    | IR1.Call (fn, args) ->
      let a2 = List.map ccs_expr args in
      IR2.Call (fn, List.map fst a2), List.flatten (List.map snd a2)
  in
  let ccs_lval = function
    | IR1.LName v -> IR2.LName v, []
    | IR1.LAddr e ->
      let e2, cs = ccs_expr e in
      IR2.LAddr e2, cs
  in
  let ccs_instr = function
    | IR1.Decl v -> IR2.Decl v, []
    | IR1.Assign (lv, e) ->
      let lv2, cs = ccs_lval lv in
      let e2, cs' = ccs_expr e in
      IR2.Assign (lv2, e2), cs @ cs'
    | IR1.Do e ->
      let e2, cs = ccs_expr e in
      IR2.Do e2, cs
    | IR1.Return e ->
      let e2, cs = ccs_expr e in
      IR2.Do e2, cs
  in
  let rec ccs_block acc_b acc_cs = function
    | i :: b ->
      let i2, cs = ccs_instr i in
      ccs_block (i2 :: acc_b) (cs @ acc_cs) b
    | [] -> List.rev acc_b, acc_cs
  in
  let ccs_def (IR1.Func (name, args, body)) =
    let body2, cs = ccs_block [] [] body in
    IR2.Func (name, args, body2), cs
  in
  let code2 = List.map ccs_def code in
  List.map fst code2, List.flatten (List.map snd code2)
;;

let simplify ir = collect_constant_strings ir

test.ml

open Ast.IR1
open Simplifier

let () =
  let ir =
    [ Func
        ( "pair"
        , [ "hd"; "tl" ]
        , [ Decl "p"
          ; Assign (LName "p", Call ("alloc", [ Value (Int 8) ]))
          ; Assign (LAddr (Var "p"), Var "hd")
          ; Assign (LAddr (Call ("_add", [ Var "p"; Value (Int 4) ])), Var "tl")
          ; Return (Var "p")
          ] )
    ; Func ("head", [ "p" ], [ Return (Call ("_deref", [ Var "p" ])) ])
    ; Func
        ( "tail"
        , [ "p" ]
        , [ Return (Call ("_deref", [ Call ("_add", [ Var "p"; Value (Int 4) ]) ])) ] )
    ; Func
        ( "main"
        , []
        , [ Decl "a"
          ; Assign (LName "a", Value (Int 42))
          ; Decl "toto"
          ; Assign (LName "toto", Call ("_add", [ Var "a"; Value (Int 9) ]))
          ; Do (Call ("puti", [ Var "toto" ]))
          ; Do (Call ("pnl", []))
          ; Decl "lst"
          ; Assign (LName "lst", Call ("pair", [ Var "a"; Value Void ]))
          ; Assign (LName "lst", Call ("pair", [ Var "toto"; Var "lst" ]))
          ; Do (Call ("puti", [ Call ("head", [ Call ("tail", [ Var "lst" ]) ]) ]))
          ; Return (Value (Int 0))
          ] )
    ]
  in
  let asm = Compiler.compile (simplify ir) in
  Mips.print_asm Stdlib.stdout asm
;;

simple.ml était là juste pour avoir un exemple simple de test pour débogguer

open Ast.IR1
open Simplifier

let () =
  let ir =
    [ Func
        ( "main"
        , []
        , [ Decl "lst"
          ; Assign (LName "lst", Call ("alloc", [ Value (Int 8) ]))
          ; Assign (LAddr (Call ("_add", [ Var "lst"; Value (Int 4) ])), Value (Int 1312))
          ; Do (Call ("puti", [ Var "lst" ]))
          ; Return (Value (Int 0))
          ] )
    ]
  in
  let asm = Compiler.compile (simplify ir) in
  Mips.print_asm Stdlib.stdout asm
;;

J’utilises un Makefile différent depuis le dernier TP qui suit le tuto que j’ai écrit ici

Makefile, pour tester rapidement : make && spim -f output.s

TEST_ML = test
OUTPUT = output

main:
	ocamlbuild -no-hygiene $(TEST_ML).byte
	./$(TEST_ML).byte > $(OUTPUT).s

clean:
	rm -r *.cmi $(TEST_ML).byte _build/ $(OUTPUT).s

symlinks:
	ln -s _build/*.cmi .

En plus pendant le cours le prof à montré une implémentation possible pour sizeof

Dans compiler.ml :

let rec sizeof = function
  | Nil_t -> 4
  | Char_t _ -> 1
  | Int_t _ -> 4
  | Ptr_t _ -> 4
  | Struct_t fields -> List.fold_left ( + ) 0 (List.map (fun (_, t) -> sizeof t) fields)
;;

Interprétation et compilation

Liste des cours

Intro

Chapitre 1

Chapitre 2 - MISP

Spim

TD1 - page 15

TD2 - page 18

TD3 - page 24

TD1

TD2

TD3

TD4

TD5

Exemple analyse descendante

TD6

TD7