let allocate_registers base_block lex_depth =
  
  (** @param av list of available variables (list of definition and associated register) @param instr the instruction code should be generated for @param needed_defs definition of variables whose values are used in the rest of the block @returns a list of available variables after the instruction and a rewrite of the code *)

  let rec alloc_instr av instr needed_defs =
    let av = ref av in

    
    (** Mark a register as unused. *)

    let free_reg r =
      av := List.filter (fun (_, r') -> r' <> r) !av
    in

    let free_var_reg v =
      free_reg (get_var_reg v)
    in

    
    (** Declare that a variable is available in a register. If some other variable was previously declared as available in the same register, it won't be anymore. *)

    let set_available vd r =
      (
        try
          if list_assoc_id vd !av = r then
            raise Not_found
          else
            failwith "a variable has two locations in memory!";
        with
          | Not_found -> ()
      );
      free_reg r;
      av := (vd, r) :: !av
    in

    
    (** Warning before and after are reversed at the end of the function! *)

    let before = ref []
    and after = ref [] in
    let do_before a =
      before := a :: !before
    in
    let do_after a =
      after := a :: !after
    in

    
    (** Debug. *)

    let dbg s = do_before (Code s) in
      
    let during =

      
      (** Spill a variable. *)

      let do_spill r vd =
        vd.vd_on_the_stack := true;
        match get_vd_type vd with
          | Other _ -> ()
          | _ -> do_before (Spill(get_vd_lex vd <> lex_depth, r, vd))
      in

      
      (** Unspill a variable. *)

      let do_unspill v =
        match get_var_type v with
          | Other _ -> do_before (Address_of(v, v)) (* TODO: this is not nice at all + we should determine if we're in the same lexical scope or not *)
          | _ ->
              (
                match v.var_def.vd_value with
                  | Some _ ->
                      let v' = copy_var v in
                        v'.var_reg <- None;
                        do_before (Mov_i(v, v'));
                  | None ->
                      do_before (Unspill (get_var_lex v <> lex_depth, v))
              )
      in

      
      (** Allocate a variable in a specific register. *)

      let alloc_in_reg v r occ =
        v.var_reg <- Some r;
        do_unspill (copy_var v); (* TODO: why copy var? *)
        set_available v.var_def r
      in

      let rec get_fresh_reg occ =
        
        (** Find an unused register. *)

        let rec find_free_int n =
          if n >= nb_registers then raise Not_found
          else if List.mem (Reg_int n) occ then
            find_free_int (n + 1)
          else if list_mem_assoc' (Reg_int n) !av then
            find_free_int (n + 1)
          else
            Reg_int n
        in
        let rec find_to_spill_int n =
          if n >= nb_registers then raise (Asm_error "no registers left during assembly generation")
          else if List.mem (Reg_int n) occ then
            find_to_spill_int (n + 1)
          else
            Reg_int n
        in
          try
            find_free_int 0
          with
            | Not_found ->
                let r = find_to_spill_int 0 in
                let replaced_vd = list_assoc' r !av in
                  spill r replaced_vd occ; free_reg r; r

      
      (** @return new occ *)

      and check_dependencies vd occ =
        match get_vd_pos vd with
          | Pos_arr(b, v, _, _) ->
              assert_avail b occ;
              if not (is_constant v) then
                assert_avail v (get_var_reg b :: occ);
              if is_constant v then
                get_var_reg b :: occ
              else
                get_var_reg v :: get_var_reg b :: occ
          | Pos_pointed p
          | Pos_rec(p, _) ->
              assert_avail p occ;
              get_var_reg p :: occ
          | _ -> occ

      
      (** Allocate an integer register to the variable v. @param occ is a list of already taken integer registers *)

      and alloc_reg v occ =
        let occ = check_dependencies v.var_def occ in
        let r = get_fresh_reg occ in
          alloc_in_reg v r occ; r
            
      (* TODO: if it's not needed anymore, don't spill it *)
      
      (** @param occ is here to specify needed registers because we might need an extra register during the spill *)

      and spill r vd occ =
        let occ = r :: (check_dependencies vd occ) in
          set_vd_ots vd;
          do_spill r vd (*;
                          free_reg r*)


      
      (** If the variable is in a register then spill it. *)

      and spill_var v occ =
        if not (is_constant v) then
          check_avail v occ (fun l -> List.iter (fun r -> spill r v.var_def occ) l)

      
      (** Make sure that a specific register is available. *)

      and spill_reg r occ =
        List.iter (fun (vd, rd) -> if r = rd then spill rd vd occ) !av

      
      (** If the variable v is available then we should execute f which will receive v's register as argument else we should execute g. *)

      and on_avail v f g =
        try
          let r = list_assoc_id v.var_def !av in
            f r
        with
          | Not_found -> g ()

      and is_complicated v =
        match get_var_pos v with
                   | Pos_rec _
                   | Pos_arr _
                   | Pos_pointed _ -> true
                   | Pos_label _
                   | Pos_stack _
                   | Pos_base _
                   | Pos_none -> false

      
      (** If variable v already was in a register it stays in it. The function f is called with the list of used registers. *)

      and check_avail v occ f =
        on_avail v
          (fun r -> v.var_reg <- Some r; f [r])
          (fun () ->
             if get_var_lex v <> lex_depth || is_complicated v then
               f [alloc_reg v occ]
             else
               (
                 if not (is_constant v) then set_var_ots v;
                 f []
               )
          )

      
      (** If the variable is not yet in a register put it in some register. *)

      and assert_avail v occ =
        check_avail v occ
          (fun r ->
             match r with
               | [] -> ignore (alloc_reg v occ)
               | _ -> ()
          )
      in

      let spill_and_free_reg r occ =
        spill_reg r occ; free_reg r
      in

      let spill_all () =
        List.iter (fun (vd, r) -> spill r vd []) !av
      in

      let just_check_avail v occ =
        check_avail v occ (fun _ -> ())
      in

      
      (** Spill iff v is complicated. *)

      let spill_complicated v occ =
        if is_complicated v then
          (
            try
              let r = get_var_reg v in
              let vd = v.var_def in
              let occ = check_dependencies vd occ in
                do_after (Spill(get_vd_lex vd <> lex_depth, r, vd))
            with
              | Not_found -> failwith "ooops"
          )
      in

        (* TODO: do not systematically free with spill_var! *)
        match instr with
          | Mov_b(v1, v2)
          | Mov_i(v1, v2)
          | Address_of(v1, v2) ->
              check_avail v2 [] (fun r2 -> assert_avail v1 r2);
              spill_complicated v1 [];
              [instr]
          | New(v1, n) ->
              spill_and_free_reg eax [];
              free_var_reg v1;
              set_available v1.var_def eax;
              [instr]

          
          (** Not commutative operations. *)

          
          (** v2 is going to be replaced. *)

          | Sub_i(v1, v2, v3) ->
              check_avail v3 []
                (fun r3 ->
                   spill_var v2 r3;
                   assert_avail v2 r3;
                   free_var_reg v2;
                   set_available v1.var_def (get_var_reg v2)
                );
              [instr]
          | Not(v1, v2)
          | Neg_i(v1, v2) ->
              spill_var v2 [];
              assert_avail v2 [];
              free_var_reg v2;
              set_available v1.var_def (get_var_reg v2);
              [instr]
          | Cmp_i(v1, v2, flags, v3) ->
              if is_constant v2 then
                (
                  assert (not (is_constant v3));
                  let av', i = alloc_instr !av (Cmp_i(v1, v3, commute_flag flags, v2)) needed_defs in
                    av := av'; i
                )
              else
                (
                  let r1 = get_fresh_reg [] in
                    check_avail v3 [r1] (fun r3 -> assert_avail v2 (r1 :: r3));
                    set_available v1.var_def r1;
                    v1.var_reg <- Some r1;
                    [instr; Set_var(flags, v1)]
                )

          
          (** Commutative operations. *)

          | And(v1, v2, v3)
          | Or(v1, v2, v3)
          | Add_i(v1, v2, v3) ->
              if is_constant v2 then
                (
                  assert (not (is_constant v3));
                  let av', i = (alloc_instr !av (commute_instr instr) needed_defs) in
                    av := av'; i
                )
              else
                (
                  check_avail v3 []
                   (fun r3 ->
                      spill_var v2 r3;
                      assert_avail v2 r3;
                      free_var_reg v2;
                      set_available v1.var_def (get_var_reg v2);
                      spill_complicated v1 []
                   );
                  [instr]
                )
          | Mult_i(v1, v2, v3) ->
              if is_constant v2 then
                (
                  assert (not (is_constant v3));
                  let av', i = (alloc_instr !av (commute_instr instr) needed_defs) in
                    av := av'; i
                )
              else
                (
                  (* TODO: use commutativity *)
                  
                  (** I386 is so dirty... The result is stored in %edx:%eax. *)

                  let occ = [eax; edx] in
                    List.iter (fun r -> spill_and_free_reg r occ) occ;
                    check_avail v3 occ
                      (fun r3 ->
                         spill_var v2 (r3 @ occ);
                         alloc_in_reg v2 eax (r3 @ occ);
                         free_reg eax;
                         set_available v1.var_def eax
                      );
                    [instr]
                )
          | Mod_i(v1, v2, v3)
          | Div_i(v1, v2, v3) ->
              
              (** I386 is so dirty... The result is stored in %edx:%eax. *)

              let occ = [eax; edx] in
                List.iter (fun r -> spill_and_free_reg r occ) occ;
                check_avail v3 occ
                  (fun r3 ->
                     spill_var v2 (r3 @ occ);
                     alloc_in_reg v2 eax (r3 @ occ);
                     free_reg eax;
                     set_available v1.var_def
                       (
                         match instr with
                           | Div_i _ -> eax
                           | Mod_i _ -> edx
                           | _ -> raise (Asm_error "internal error")
                       )
                  );
                [instr]
          | Proc(p, l) ->
              
              (** Let's save used registers. *)

              spill_all ();
              
              (** Those registers might be needed for copying arrays and records. *)

              let occ = [ecx; esi; edi] in
                List.iter (fun r -> spill_and_free_reg r occ) occ;
                let pushes = 
                  (List.rev
                     (List.fold_left2 (* TODO: fold_left *)
                        (fun l a v ->
                           (
                             just_check_avail v occ;
                             match get_var_type v with
                               | Other _ ->
                                   (* assert_avail v occ; *)
                                   Push_o(v, sizeof (get_var_type v))
                               | _ ->
                                   Push v
                           ) :: l
                        ) [] p.proc_args l))
                in
                  av := [];
                  pushes @ [Call p.proc_name;
                            Add_i (get_stack_pos_var (),
                                   get_stack_pos_var (),
                                   new_const_int_var (List.fold_left (fun s a -> s + (sizeof (get_vd_type a))) 0 p.proc_args) lex_depth)]
          | Fun(x, p, l) ->
              
              (** Let's save used registers. *)

              spill_all ();
              
              (** Those registers might be needed for copying arrays and records. *)

              let occ = [ecx; esi; edi] in
                List.iter (fun r -> spill_and_free_reg r occ) occ;
                let pushes = 
                  (List.rev
                     (List.fold_left2
                        (fun l a v ->
                           (
                             just_check_avail v occ;
                             match get_var_type v with
                               | Other _ ->
                                   (* assert_avail v occ; *)
                                   Push_o(v, sizeof (get_var_type v))
                               | _ ->
                                   Push v
                           ) :: l
                        ) [] p.proc_args l))
                in
                  av := [];
                  set_available x.var_def eax;
                  pushes @ [Call p.proc_name;
                            Add_i (get_stack_pos_var (),
                                   get_stack_pos_var (),
                                   new_const_int_var (List.fold_left (fun s a -> s + (sizeof (get_vd_type a))) 0 p.proc_args) lex_depth)]
          | Delete v -> []
          | Return v ->
              just_check_avail v [];
              spill_all ();
              [instr]
          | Nop -> []
          | Assert_avail v -> assert_avail v []; []
          | Check_avail_with_flags v -> just_check_avail v []; []
          | Spill_var v ->
              spill_var v []; []
          | Spill_all ->
              spill_all (); []
          | Code _
          | Set_var _
          | Unspill _
          | Spill _
          | Push_o _
          | Push _
          | Call _
          | Check_avail _
          | Read_flag _ -> raise (Asm_error "internal error in alloc_instr (encountered an instruction which should not have been generated)")
    in
      !av, (List.rev !before) @ during @ (List.rev !after)
  in
    (* TODO: data-flow equations *)
    (*
      let get_needed_var_defs_in_instr = function
      | Mov_i(_, v2)
      | Mov_b(_, v2) -> [v2]
      | Add_i(_, v2, v3)
      | Cmp_i(_, v2, _, v3)
      | Mult_i(_, v2, v3) -> [v2; v3]
      in
    *)

  let rec get_needed_var_defs i =
    (* TODO: remove duplicates *)
    (* List.concat (List.map get_needed_var_defs_in_instr i) *)
    []
  in
  let used_var_defs_in_instrs = get_needed_var_defs
  in

  
  (** Allocate registers for a list of instructions. @param nd list of variable definition needed after the block @returns a list of available variables after the instruction and a rewrite of the code *)

  (* TODO: fill nd correctly *)
  let rec alloc_instrs av nd = function
    | h :: t ->
        let av', i' = alloc_instr av h [] (*used_var_defs_in_instrs t*) in (* TODO: use nd *)
        let av'', i'' = alloc_instrs av' nd t in
          av'', i' @ i''
    | [] -> av, []
  in

  
  (** Allocate registers for the base block. *)

  let rec alloc_base_block av base_block =
    
    (** Assembly needed by the following base blocks. *)

    let needed =
      match base_block.bb_link with
        | If(v, _, _, _) -> [Check_avail_with_flags v]
        | While _
        | End -> []
    in
      (* TODO: the Spill_all is not really nice *)
      (* TODO: compute variables needed in the next blocks *)
    let av, instrs = alloc_instrs av [] (base_block.bb_block @ [Spill_all] @ needed) in
    let instrs = ref instrs in
      (
        match base_block.bb_link with
          | If(v, b1, b2, b3) ->
              let av1 = alloc_base_block av b1 in
              let av2 = alloc_base_block av b2 in
                ignore (alloc_base_block
                          [] (* TODO: we could use the " of av1 and av2 *)
                          b3)
          | While(v, be, b1, b2) ->
              be.bb_block <- be.bb_block @ [Check_avail_with_flags v];
              let ave = alloc_base_block av be in
              let av1 = alloc_base_block ave b1 in (* TODO: is ave correct? *)
                ignore (alloc_base_block av1 b2)
          | End -> ()
      );
      base_block.bb_block <- !instrs; av
  in
    ignore (alloc_base_block [] base_block)