(* GC Stop & Copy *)

open Format
open Array  

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 "  deslocação size=%d de %d para %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 "memória ocupada após recolha = %d palavras@\n" (!next - to_space);
  !next


let first_space = ref true
  (* true  = alocamos no primeiro meio-espaço
             i.e. from_space = 0 / to_space = space_size
     false = alocamos no segundo meio-espaço
             i.e. from_space = space_size / to_space = 0 *)
let next = ref 0
  (* primeiro espaço livre *)

(* alocamos um bloco de tamanho size i.e. com size campos *)
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
    (* há espaço suficiente *)
    let p = !next in
    memory.(p) <- size;
    next := !next + size + 1;
    p
  end else begin
    (* não há espaço suficiente *)
    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;;

(****

(* teste com o exemplo da aula *)

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

****)

(* resposta à adivinha :

   As funções insert e sort são recursivas e parte dos dados
   encontra-se assim as vezes arquivadas temporariamente na pilha, 
   que é aqui a pilha de OCaml, logo não está materializada na memória.

   No caso extremo em que ram=100 e n=16 a integralidade da lista ocupa 48
   palavras, para um meio-espaço de 50 palavras. Quando invocamos "sort", esta
   percorre a lista recursivamente, mantendo os elementos  nas variáveis 
   locais "y" que estão na pilha. Chegando ao fim, esta invoca "insert"
   e, visto que roots.(0)=-1, a primeira coisa que faz "insert" é alocar um
   bloco de tamanho 3 com "cons0 x". Visto não haver espaço, chamamos o
   GC, que recupera então toda a memória visto que roots.(0)=-1. Mas a lista
   sera reconstruída em memória, a partir dos valores arquivados em pilha.

*)

This document was generated using caml2html