Project

General

Profile

« Previous | Next » 

Revision c4780a6a

Added by LĂ©lio Brun 7 months ago

work on new reset functions generation

View differences:

src/backends/C/c_backend_common.ml
298 298
  | Const_string _
299 299
  | Const_modeid _ -> assert false (* string occurs in annotations not in C *)
300 300

  
301
                  
301
let reset_flag_name = "_reset"
302
let pp_reset_flag ?(indirect=true) fmt self =
303
  fprintf fmt "%s%s%s" self (if indirect then "->" else ".") reset_flag_name
304

  
305
let pp_reset_assign self fmt b =
306
  fprintf fmt "%a = %i;"
307
    (pp_reset_flag ~indirect:true) self (if b then 1 else 0)
308

  
302 309
(* Prints a value expression [v], with internal function calls only.
303 310
   [pp_var] is a printer for variables (typically [pp_c_var_read]),
304 311
   but an offset suffix may be added for array variables
......
329 336
       pp_var fmt v
330 337
  | Fun (n, vl) ->
331 338
    pp_basic_lib_fun (Types.is_int_type v.value_type) n pp_c_val fmt vl
339
  | ResetFlag ->
340
    pp_reset_flag fmt self
341

  
332 342

  
333 343
(* Access to the value of a variable:
334 344
   - if it's not a scalar output, then its name is enough
......
472 482
  | Array vl    -> 1 + List.fold_right (fun v -> max (expansion_depth v)) vl 0
473 483
  | Access (v, _) -> max 0 (expansion_depth v - 1)
474 484
  | Power _  -> 0 (*1 + expansion_depth v*)
485
  | ResetFlag -> 0
475 486
and expansion_depth_cst c =
476 487
  match c with
477 488
  | Const_array cl ->
......
604 615
      fprintf fmt "%a%a" pp_var v pp_suffix loop_vars
605 616
  | _, Cst cst ->
606 617
    pp_c_const_suffix var_type fmt cst
618
  | _, ResetFlag ->
619
    pp_reset_flag fmt self
607 620
  | _, _ ->
608 621
    eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@."
609 622
      Types.print_ty var_type (pp_val m) value pp_suffix loop_vars;
......
676 689
    (pp_machine_memtype_name ~ghost:false) name
677 690

  
678 691
module type MODIFIERS_GHOST_PROTO = sig
679
  val pp_ghost_parameters: formatter -> (string * (formatter -> string -> unit)) list -> unit
692
  val pp_ghost_parameters: ?cut:bool -> formatter -> (string * (formatter -> string -> unit)) list -> unit
680 693
end
681 694

  
682 695
module EmptyGhostProto: MODIFIERS_GHOST_PROTO = struct
683
  let pp_ghost_parameters _ _ = ()
696
  let pp_ghost_parameters ?cut _ _ = ()
684 697
end
685 698

  
686 699
module Protos (Mod: MODIFIERS_GHOST_PROTO) = struct
687 700

  
688 701
  let pp_mem_ghost name fmt mem =
689 702
    pp_machine_decl ~ghost:true
690
      (fun fmt mem -> fprintf fmt "\ghost %a" pp_ptr mem) fmt
703
      (fun fmt mem -> fprintf fmt "\\ghost %a" pp_ptr mem) fmt
691 704
      (name, mem)
692 705

  
693 706
  let print_clear_reset_prototype self mem fmt (name, static) =
......
697 710
         pp_c_decl_input_var) static
698 711
      (pp_machine_memtype_name ~ghost:false) name
699 712
      self
700
      Mod.pp_ghost_parameters [mem, pp_mem_ghost name]
713
      (Mod.pp_ghost_parameters ~cut:true) [mem, pp_mem_ghost name]
701 714

  
702 715
  let print_set_reset_prototype self mem fmt (name, static) =
703 716
    fprintf fmt "@[<v>void %a (%a%a *%s)%a@]"
......
706 719
         pp_c_decl_input_var) static
707 720
      (pp_machine_memtype_name ~ghost:false) name
708 721
      self
709
      Mod.pp_ghost_parameters [mem, pp_mem_ghost name]
722
      (Mod.pp_ghost_parameters ~cut:true) [mem, pp_mem_ghost name]
710 723

  
711 724
  let print_step_prototype self mem fmt (name, inputs, outputs) =
712 725
    fprintf fmt "@[<v>void %a (@[<v>%a%a%a *%s@])%a@]"
......
717 730
         ~pp_epilogue:pp_print_cut pp_c_decl_output_var) outputs
718 731
      (pp_machine_memtype_name ~ghost:false) name
719 732
      self
720
      Mod.pp_ghost_parameters [mem, pp_mem_ghost name]
733
      (Mod.pp_ghost_parameters ~cut:true) [mem, pp_mem_ghost name]
721 734

  
722 735
  let print_init_prototype self fmt (name, static) =
723 736
    fprintf fmt "void %a (%a%a *%s)"
......
879 892
    inout idx;
880 893
  "f_" ^ inout ^ string_of_int idx
881 894

  
895
let pp_basic_assign pp_var fmt typ var_name value =
896
  if Types.is_real_type typ && !Options.mpfr
897
  then
898
    Mpfr.pp_inject_assign pp_var fmt (var_name, value)
899
  else
900
    fprintf fmt "%a = %a;"
901
      pp_var var_name
902
      pp_var value
903

  
904
(* type_directed assignment: array vs. statically sized type
905
   - [var_type]: type of variable to be assigned
906
   - [var_name]: name of variable to be assigned
907
   - [value]: assigned value
908
   - [pp_var]: printer for variables
909
*)
910
let pp_assign m self pp_var fmt (var, value) =
911
  let depth = expansion_depth value in
912
  let var_type = var.var_type in
913
  let var = mk_val (Var var) var_type in
914
  (*eprintf "pp_assign %a %a %a %d@." Types.print_ty var_type pp_val var_name pp_val value depth;*)
915
  let loop_vars = mk_loop_variables m var_type depth in
916
  let reordered_loop_vars = reorder_loop_variables loop_vars in
917
  let rec aux typ fmt vars =
918
    match vars with
919
    | [] ->
920
      pp_basic_assign (pp_value_suffix m self var_type loop_vars pp_var)
921
        fmt typ var value
922
    | (d, LVar i) :: q ->
923
      let typ' = Types.array_element_type typ in
924
      (*eprintf "pp_aux %a %s@." Dimension.pp_dimension d i;*)
925
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"
926
        i i i pp_c_dimension d i
927
        (aux typ') q
928
    | (d, LInt r) :: q ->
929
      (*eprintf "pp_aux %a %d@." Dimension.pp_dimension d (!r);*)
930
      let typ' = Types.array_element_type typ in
931
      let szl = Utils.enumerate (Dimension.size_const_dimension d) in
932
      fprintf fmt "@[<v 2>{@,%a@]@,}"
933
        (pp_print_list (fun fmt i -> r := i; aux typ' fmt q)) szl
934
    | _ -> assert false
935
  in
936
  begin
937
    reset_loop_counter ();
938
    (*reset_addr_counter ();*)
939
    aux var_type fmt reordered_loop_vars;
940
    (*eprintf "end pp_assign@.";*)
941
  end
882 942

  
883 943
(* Local Variables: *)
884 944
(* compile-command:"make -C ../../.." *)

Also available in: Unified diff