Project

General

Profile

« Previous | Next » 

Revision a7062da6

Added by LĂ©lio Brun over 3 years ago

another step towards refactoring

View differences:

src/backends/C/c_backend_common.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
open Utils.Format
12
open Utils
13
open Format
13 14
open Lustre_types
14 15
open Corelang
15 16
open Machine_code_types
......
88 89
  {
89 90
    var_id = id;
90 91
    var_orig = false;
91
    var_dec_type = mktyp Location.dummy_loc Tydec_any;
92
    var_dec_clock = mkclock Location.dummy_loc Ckdec_any;
92
    var_dec_type = mktyp Location.dummy Tydec_any;
93
    var_dec_clock = mkclock Location.dummy Ckdec_any;
93 94
    var_dec_const = false;
94 95
    var_dec_value = None;
95 96
    var_parent_nodeid = None;
......
237 238
(* Not a basic C type. Do not handle arrays or pointers *)
238 239

  
239 240
let pp_basic_c_type ?(pp_c_basic_type_desc = pp_c_basic_type_desc)
240
    ?(var_opt = None) fmt t =
241
    ?var_opt fmt t =
241 242
  match var_opt with
242 243
  | Some v when Machine_types.is_exportable v ->
243 244
    Machine_types.pp_c_var_type fmt v
......
248 249
  let rec aux t pp_suffix =
249 250
    if is_basic_c_type t then
250 251
      fprintf fmt "%a %s%a"
251
        (pp_basic_c_type ?pp_c_basic_type_desc ~var_opt)
252
        (pp_basic_c_type ?pp_c_basic_type_desc ?var_opt)
252 253
        t var_id pp_suffix ()
253 254
    else
254 255
      let open Types in
......
512 513
   (Access (v, Cst (Const_int !r))) q | _ , LVar i :: q -> value_offsets (Access
513 514
   (v, Var i)) q *)
514 515
(* Computes the list of nested loop variables together with their dimension
515
   bounds. - LInt r stands for loop expansion (no loop variable, but int loop
516
   index) - LVar v stands for loop variable v *)
516
   bounds.
517
 *  - LInt r stands for loop expansion (no loop variable, but int loop
518
      index)
519
 *  - LVar v stands for loop variable v *)
517 520
let rec mk_loop_variables m ty depth =
518 521
  match (Types.repr ty).Types.tdesc, depth with
519 522
  | Types.Tarray (d, ty'), 0 ->
......
592 595
  in
593 596
  match loop_vars, value.value_desc with
594 597
  | (x, LAcc i) :: q, _ when is_const_index i ->
595
    let r = ref (Dimension.size_const_dimension (dimension_of_value i)) in
598
    let r = ref (Dimension.size_const (dimension_of_value i)) in
596 599
    pp_value_suffix ~indirect m self var_type ((x, LInt r) :: q) pp_var fmt
597 600
      value
598 601
  | (_, LInt r) :: q, Cst (Const_array cl) ->
......
664 667
 *     pp_c_decl_struct_var
665 668
 *     fmt m.mmemory *)
666 669

  
667
let print_machine_struct ?(ghost = false) fmt m =
670
let pp_machine_struct ?(ghost = false) fmt m =
668 671
  if not (fst (Machine_code_common.get_stateless_status m)) then
669 672
    (* Define struct *)
670 673
    fprintf fmt "@[<v 2>%a {@,_Bool _reset;%a%a@]@,};"
......
693 696
(* Prototype Printing functions *)
694 697
(********************************************************************************************)
695 698

  
696
let print_global_init_prototype fmt baseNAME =
699
let pp_global_init_prototype fmt baseNAME =
697 700
  fprintf fmt "void %a ()" pp_global_init_name baseNAME
698 701

  
699
let print_global_clear_prototype fmt baseNAME =
702
let pp_global_clear_prototype fmt baseNAME =
700 703
  fprintf fmt "void %a ()" pp_global_clear_name baseNAME
701 704

  
702
let print_alloc_prototype fmt (name, static) =
705
let pp_alloc_prototype fmt (name, static) =
703 706
  fprintf fmt "%a * %a %a"
704 707
    (pp_machine_memtype_name ~ghost:false)
705 708
    name pp_machine_alloc_name name
706 709
    (pp_print_parenthesized pp_c_decl_input_var)
707 710
    static
708 711

  
709
let print_dealloc_prototype fmt name =
712
let pp_dealloc_prototype fmt name =
710 713
  fprintf fmt "void %a (%a * _alloc)" pp_machine_dealloc_name name
711 714
    (pp_machine_memtype_name ~ghost:false)
712 715
    name
......
783 786
      outputs
784 787
end
785 788

  
786
let print_import_prototype fmt dep = fprintf fmt "#include \"%s.h\"" dep.name
789
let pp_import_prototype fmt dep = fprintf fmt "#include \"%s.h\"" dep.name
787 790

  
788
let print_import_alloc_prototype fmt dep =
791
let pp_import_alloc_prototype fmt dep =
789 792
  if dep.is_stateful then fprintf fmt "#include \"%s_alloc.h\"" dep.name
790 793

  
791 794
let pp_c_var m self pp_var fmt var =
......
858 861
    file_suffix typ arg file_suffix
859 862

  
860 863
let pp_put_var fmt file_suffix name var_type var_id =
861
  let pp_file = pp_print_file ("out" ^ file_suffix) in
864
  let pp_file = pp_file ("out" ^ file_suffix) in
862 865
  let unclocked_t = Types.unclock_type var_type in
863 866
  fprintf fmt "@[<v>%a@]"
864 867
    (fun fmt () ->
......
937 940
    | (d, LInt r) :: q ->
938 941
      (*eprintf "pp_aux %a %d@." Dimension.pp_dimension d (!r);*)
939 942
      let typ' = Types.array_element_type typ in
940
      let szl = Utils.enumerate (Dimension.size_const_dimension d) in
943
      let szl = Utils.enumerate (Dimension.size_const d) in
941 944
      fprintf fmt "@[<v 2>{@,%a@]@,}"
942 945
        (pp_print_list (fun fmt i ->
943 946
             r := i;

Also available in: Unified diff