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 *)

  (* TODO: really compute and use needed_defs *)
  let rec alloc_instr av instr needed_defs =
    let av = ref av in
      
      (** Declare that a variable is avaiable in a register. If some other variable was previously declared as available in the same register, it won't be anymore. *)

    let set_available v r =
      if list_mem_assoc_id v !av then failwith "a variable has two locations in memory!";
      av := (v, r) :: (List.filter (fun (_, r') -> r' <> r) !av)
    in

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

    let before = ref []
    and after = ref [] in (* TODO: remove after if it's not used *)
    let do_before a =
      before := a :: !before
    in
    let do_after a =
      after := a :: !after
    in
      
    let during =
      
      (** Mark a register as unused. *)

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

      
      (** Spill a variable. *)

      let rec 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))

      
      (** Unspill a variable. *)

      and 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 *)
          | _ ->
              do_before (Unspill (get_var_lex v <> lex_depth, v))

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

      and alloc_in_reg v r occ =
        
        (** Warning: v.var_reg should be set for flags! *)

        match v.var_reg with
          | Some ((Reg_flag f) as rf) ->
              v.var_reg <- Some r;
              do_before (Set_var(f, v));
              free_reg rf;
              set_available v.var_def r; r
          | Some r -> r (* TODO: do not compute the first r in this case! *)
          | None ->
              (
                match v.var_def.vd_value with
                  | Some _ ->
                      v.var_reg <- Some r;
                      let v' = copy_var v in
                        v'.var_reg <- None;
                        do_before (Mov_i(v, v'));
                        set_available v.var_def r; r
                  | None ->
                      v.var_reg <- Some r;
                      do_unspill (copy_var v);
                      set_available v.var_def r; r
              )
                
      
      (** Allocate an integer register to the variable v. @param occ is a list of already taken integer registers *)

      and alloc_reg v occ =
        (* TODO: should this be there or in check_avail? *)
        let occ =
          match get_var_pos v with
            | Pos_arr(a, v, _, _) -> get_var_reg a :: get_var_reg v :: occ
            | Pos_rec(p, _)
            | Pos_pointed p -> get_var_reg p :: occ
            | Pos_base _
            | Pos_stack _
            | Pos_label _
            | Pos_none -> occ
        in
        let r =

          
          (** 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
            (* TODO: spill the one which will not be used during the most long time *)
          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_free true r replaced_vd occ; r
        in
          alloc_in_reg v r occ
            
      (* TODO: if it's not needed anymore, don't spill it *)
      
      (** @param free should we declare the freed variable's register as free? @param occ is here to specify needed registers because we might need an extra register during the spill *)

      and spill_free free r vd occ =
        vd.vd_on_the_stack := true;
        (
          match get_vd_pos vd with
            | Pos_arr(b, v, _, _) ->
                assert_avail b occ; assert_avail v occ
            | Pos_pointed p
            | Pos_rec(p, _) -> assert_avail p occ
            | _ -> ()
        );
        (
          match r with
            | Reg_int _ ->
                do_spill r vd;
                if free then free_reg r
            | Reg_flag f ->
                let v = new_var vd in
                  v.var_reg <- Some r;
                  free_reg r; (* TODO: this is not really nice but else we get the " error *)
                  (
                    (* TODO: why do we need to do that? *)
                    try
                      v.var_reg <- Some (list_assoc_id v.var_def !av)
                    with
                      | _ -> ignore (alloc_reg v occ)
                  );
                  let r' = get_var_reg v in
                    do_spill r' vd;
                    free_reg r';
                    if free then free_reg r
        );

      and spill_var_free free v occ =
        check_avail_flags true v occ (fun l -> List.iter (fun r -> spill_free free 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_free true 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 ()

      
      (** If variable v already was in a register it stays in it. The function f is called with the list of used registers. The second argument tells whether it is acceptable or not for it to be stored in flags. *)

      and check_avail_flags flags v occ f =
        let check_pos occ = function
          | Pos_rec(v, _)
          | Pos_pointed v -> assert_avail v occ; get_var_reg v :: occ
          | Pos_arr(a, v, _, _) ->
              assert_avail a occ;
              let occ = get_var_reg a :: occ in
                assert_avail v occ;
                get_var_reg v :: occ
          | Pos_base _ | Pos_stack _ | Pos_label _ | Pos_none -> occ
        in
          v.var_reg <- None(* TODO: is that useful? *)
          on_avail v
            (fun r ->
               (* let occ = check_pos (r :: occ) v.var_def.vd_pos in *)
               let r =
                 if flags && !Params.use_flags then r
                 else
                   match r with
                     | Reg_flag _ ->
                         v.var_reg <- Some r;
                         alloc_reg v occ
                     | _ -> r
               in
                 v.var_reg <- Some r; f [r]
            )
            (fun () ->
               let occ = check_pos occ (get_var_pos v) in
                 if get_var_lex v <> lex_depth || get_var_type v = Boolean then
                   f [alloc_reg v occ]
                 else
                   (
                     if not (is_constant v) then
                       v.var_def.vd_on_the_stack := true;
                     f []
                   )
            )

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

      and assert_avail v occ =
        check_avail_flags false v occ
          (fun r ->
             match r with
               | [] -> ignore (alloc_reg v occ)
               | [Reg_flag f] -> ignore (alloc_reg v occ) 
               | _ -> ()
          )
      in
      let spill = spill_free true in

      
      (** If the variable is in a register then spill it. Its register is then marked as free. *)

      let spill_var = spill_var_free true in
        
      let spill_all () =
        List.iter (fun (vd, r) ->
                     match r with
                       | Reg_int _ ->
                           vd.vd_on_the_stack := true;
                           spill r vd []
                       | Reg_flag _ -> () (* TODO! *)
                  ) !av
      in
      let check_avail = check_avail_flags false in
      let just_check_avail v occ =
        check_avail v occ (fun _ -> ())
      in
      let used_and_replaced v occ =
        if !(Params.minimize_spills) then
          (
            spill_var_free false v occ;
            assert_avail v occ; (* TODO: we do not need to load the value *)
            free_reg (get_var_reg v)
          )
        else
          (
            spill_var v occ;
            assert_avail v occ
          )
      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 ->
                   spill_var v1 r2;
                   (* TODO: we don't need to load v1's value *)
                   assert_avail v1 r2;
                   (* used_and_replaced v1 r2; *)
                   (* set_available v1.var_def (get_var_reg v1) *)
                );
              (* check_avail v2 []
                 (fun r2 -> ignore (alloc_reg v1 r2)); *)

              (
                match get_var_pos v1 with
                  | Pos_pointed _
                  | Pos_arr _
                  | Pos_rec _ -> do_after (Spill(false, get_var_reg v1, v1.var_def)); free_reg (get_var_reg v1)
                  | _ -> ()
              );
              [instr]
          | New(v1, n) ->
              used_and_replaced 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_free false v2 r3;
                   set_available v1.var_def (alloc_reg v2 r3)
                );
              [instr]
          | Not(v1, v2)
          | Neg_i(v1, v2) ->
              used_and_replaced v2 [];
              let r2 = get_var_reg v2 in
                set_available v1.var_def r2;
                [instr]
          | Cmp_i(v1, v2, flags, v3) ->
              if is_constant v2 then
                (
                  assert (not (is_constant v3)); (* TODO *)
                  let av', i = alloc_instr !av (Cmp_i(v1, v3, commute_flag flags, v2)) needed_defs in
                    av := av'; i
                )
              else
                (
                  
                  (** If there was already somebody in the flags we spill it. *)

                  List.iter
                   (fun (vd, r) ->
                      match r with
                        | Reg_flag f -> spill r vd []
                        | _ -> ()
                   ) !av;
                  check_avail v3 []
                    (fun r3 ->
                       assert_avail v2 r3;
                       let r2 = get_var_reg v2 in
                         set_available v1.var_def (Reg_flag flags)
                    );
                  [instr]
                )

          
          (** 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 ->
                      used_and_replaced v2 r3;
                      let r2 = get_var_reg v2 in
                        set_available v1.var_def r2
                   );
                  [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_reg r occ) occ;
                    check_avail v3 occ
                      (fun r3 ->
                         spill_var v2 (r3 @ occ);
                         ignore (alloc_in_reg v2 eax (r3 @ occ));
                         free_reg eax;
                         free_reg edx;
                         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_reg r occ) occ;
                assert_avail v3 occ;
                let r3 = [get_var_reg v3] in
                  spill_var v2 (r3 @ occ);
                  ignore (alloc_in_reg v2 eax (r3 @ occ));
                  free_reg eax;
                  free_reg edx;
                  set_available v1.var_def
                    (Reg_int
                       (
                         match instr with
                           | Div_i _ -> 0
                           | Mod_i _ -> 3
                           | _ -> 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
              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 := [];
                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
              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 := [];
                used_and_replaced x occ;
                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 [];
              [instr]
          | Nop -> []
          | Assert_avail v -> assert_avail v []; []
          | Check_avail_with_flags v -> check_avail_flags false v [] (fun _ -> ()); []
          | 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)