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 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 v r =
      if list_mem_assoc_id v !av then failwith "a variable has two locations in memory!";
      (* if list_mem_assoc' r !av then failwith "; *)
      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
    let do_before a =
      before := a :: !before
    in

    (* TODO: remove *)
    let print_av av =
      do_before
        (Code
           ((List.fold_left
               (fun s ->
                  (function
                     | (vd, Reg_int i) -> s ^ " " ^ (string_of_int i) ^ "," ^ (string_of_int vd.vd_ident)
                     | _ -> s ^ " ?"
                  )) "av:" av) ^ "\n")
        )
    in
      (* let do_before a =
         do_before a; print_av !av;
         in *)


    let during =
      
      (** Mark a register as unused. *)

      let free_reg r =
        av := List.filter (fun (_, r') -> r' <> r) !av
      in
      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))
      and do_unspill v =
        match get_var_type v with
          | Other _ -> 
              do_before (Address_of(v,v))
          | _ ->
              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
          | 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 =
          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;
                  (
                    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
        );

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

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

      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;
            free_reg (get_var_reg v)
          )
        else
          (
            spill_var v occ;
            assert_avail v occ
          )
      in
        match instr with
          | Mov_b(v1, v2)
          | Not(v1, v2)
          | Neg_i(v1, v2)
          | Mov_i(v1, v2) ->
              assert_avail v2 [];
              ignore(alloc_reg v1 [get_var_reg v2]);
              [instr]
          | Address_of(v1, v2) ->
              ignore(alloc_reg v1 []);
              [instr]
          | New(v1, n) ->
              set_available v1.var_def (Reg_int 8);
              [instr]
          | Mult_i(v1, v2, v3)
          | And(v1, v2, v3)
          | Or(v1, v2, v3)
          | Div_i(v1, v2, v3)
          | Mod_i(v1, v2, v3)
          | Add_i(v1, v2, v3)
          | Sub_i(v1, v2, v3)
          | Cmp_i(v1, v2, _, v3) ->
              assert_avail v2 [];
              assert_avail v3 [get_var_reg v2];
              ignore(alloc_reg v1 [get_var_reg v2; get_var_reg v3]);
              [instr]
          | Proc(p, l) ->
              spill_all();
              let argv = Array.of_list l in
                for i = 0 to min 6 ((Array.length argv)-1) do
                  let v = argv.(i) in
                  match get_var_type v with
                    | Other _ ->
                        assert_avail v [];
                        do_before(Push_o(v, sizeof(get_var_type v)))
                    | _ ->
                        let a = get_reg_var(Reg_int (i+8)) in
                          assert_avail argv.(i) [];
                          do_before(Mov_i (a,argv.(i)))
                done;
                for i = 7 to Array.length argv do
                  let v = argv.(i) in
                    match get_var_type v with
                      | Other _ -> 
                        assert_avail v [];
                        do_before(Push_o(v, sizeof(get_var_type v)))
                      | _ ->
                          do_before(Push argv.(i))
                done;
                [Call p.proc_name]
          | Fun(x,p,l) ->
              spill_all();
              let argv = Array.of_list l in
                for i = 0 to min 6 ((Array.length argv)-1) do
                  let v = argv.(i) in
                  match get_var_type v with
                    | Other _ ->
                        assert_avail v [];
                        do_before(Push_o(v, sizeof(get_var_type v)))
                    | _ ->
                        let a = get_reg_var(Reg_int (i+8)) in
                          assert_avail argv.(i) [];
                          do_before(Mov_i (a,argv.(i)))
                done;
                for i = 7 to Array.length argv do
                  let v = argv.(i) in
                    match get_var_type v with
                      | Other _ -> 
                        assert_avail v [];
                        do_before(Push_o(v, sizeof(get_var_type v)))
                      | _ ->
                          do_before(Push argv.(i))
                done;
                set_available x.var_def (Reg_int 8);
                [Call p.proc_name]
          | Delete _
          | Return _ 
          | Nop -> [instr]
          | 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
    
    (** Allocate registers for a list of instructions. @returns a list of available variables after the instruction and a rewrite of the code *)

  let rec alloc_instrs av nd = function
    | h :: t ->
        let av', i' = alloc_instr av h [] (*used_var_defs_in_instrs t*) in
        let av'', i'' = alloc_instrs av' nd t in
          av'', i' @ i''
    | [] -> av, []
  in
  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
    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 -> (* (** Let's spill everything. *)
              instrs := !instrs @ (List.fold_left (fun l (vd, r) ->
                                                     match r with
                                                       | Reg_int _ ->
                                                           vd.vd_on_the_stack := true;
                                                           Spill(get_ vd <> lex_depth, r, vd) :: l
                                                       | Reg_flag _ -> l (* TODO! *)
                                                  ) [] av) *)
 ()
      );
      base_block.bb_block <- !instrs; av
  in
    ignore (alloc_base_block [] base_block)