(* GC Stop & Copy *)

open Format
open Array (* une fois n'est pas coutume *)

let ram = 100
let memory = make ram 0
let space_size = ram / 2
let max_roots = 10
let roots = make max_roots (-1)

let is_pointer start p = start <= p && p < start + space_size

let stop_and_copy from_space to_space =
  (* printf "collection from_space=%d to_space=%d@." from_space to_space; *)
  let next = ref to_space in
  let forward p =
    if is_pointer from_space p then
      if is_pointer to_space memory.(p + 1) then
        memory.(p + 1)
      else begin
        let size = memory.(p) in
        let p' = !next in
        (* printf "  déplacement size=%d de %d vers %d@." size p p'; *)
        memory.(p') <- size;
        for i = 1 to size do memory.(p' + i) <- memory.(p + i) done;
        memory.(p + 1) <- p';
        next := !next + size + 1;
        p'
      end
    else
      p
  in
  let scan = ref to_space in
  for r = 0 to length roots - 1 do
    roots.(r) <- forward roots.(r)
  done;
  while !scan < !next do
    let size = memory.(!scan) in
    for i = 1 to size do
      memory.(!scan + i) <- forward memory.(!scan + i)
    done;
    scan := !scan + size + 1
  done;
  printf "mémoire occupée après collection = %d mots@\n" (!next - to_space);
  !next


let first_space = ref true
  (* true  = on alloue dans le premier demi-espace
             i.e. from_space = 0 / to_space = space_size
     false = on alloue dans le second demi-espace
             i.e. from_space = space_size / to_space = 0 *)
let next = ref 0
  (* premier emplacement libre *)

(* alloue un bloc de taille size i.e. avec size champs *)
let rec alloc size =
  let from_space = if !first_space then 0 else space_size in
  let limit = from_space + space_size in
  if !next + size + 1 <= limit then begin
    (* il y a assez de place *)
    let p = !next in
    memory.(p) <- size;
    next := !next + size + 1;
    p
  end else begin
    (* pas assez de place *)
    let to_space = if !first_space then space_size else 0 in
    next := stop_and_copy from_space to_space;
    if !next + size + 1 >= to_space + limit then failwith "out of memory";
    first_space := not !first_space;
    alloc size
  end

let reset () =
  fill memory 0 ram (-42);
  fill roots 0 max_roots (-1);
  first_space := true;
  next := 0;;

(****

(* test avec l'exemple du cours *)

let _ =
  fill memory 0 ram (-42);
  fill roots 0 max_roots (-1);
  roots.(0) <- 9;
  roots.(1) <- 3;
  blit [| 2; -1; 3;
          2; -2; 6;
          2; -3; -1;
          2; -2; -1;
          2; 9; 3 |] 0 memory 0 15;
  stop_and_copy 0 space_size

****)

(* réponse à la devinette :

   Les fonctions insert et sort sont récursives et une partie des données
   se trouve donc parfois stockée temporairement sur la pile, qui est ici la
   pile d'ocaml et n'est pas matérialisée en mémoire.

   Dans le cas extrême où ram=100 et n=16 l'intégralité de la liste occupe 48
   mots, pour un demi-espace de 50 mots. Quand on appelle "sort", elle parcourt
   la liste récursivement, on conservant les éléments dans les variables
   locales y se trouvant sur la pile. Arrivée au bout, elle appelle "insert"
   et, vu que roots.(0)=-1, la première chose que fait insert c'est allouer un
   bloc de taille 3 avec "cons0 x". Vu qu'il n'y a pas la place, on appelle le
   GC, qui récupère alors toute la mémoire vu que roots.(0)=-1. Mais la liste
   sera bien reconstruite en mémoire, à partir des valeurs stockées en pile.

*)

This document was generated using caml2html