Project

General

Profile

Revision 01d48bb0 src/backends/C/c_backend_header.ml

View differences:

src/backends/C/c_backend_header.ml
36 36
let print_import_standard fmt =
37 37
  fprintf fmt "#include \"%s/arrow.h\"@.@." Version.include_path
38 38

  
39
let print_static_declare_instance attr fmt (i, (m, static)) =
39
let rec print_static_val pp_var fmt v =
40
  match v with
41
  | Cst c         -> pp_c_const fmt c
42
  | LocalVar v    -> pp_var fmt v
43
  | Fun (n, vl)   -> Basic_library.pp_c n (print_static_val pp_var) fmt vl
44
  | _             -> (Format.eprintf "Internal error: C_backend_header.print_static_val"; assert false)
45

  
46
let print_constant m pp_var fmt v =
47
  Format.fprintf fmt "inst ## %s = %a"
48
    v.var_id
49
    (print_static_val pp_var) (Machine_code.get_const_assign m v)
50

  
51
let print_static_constant (m, attr, inst) fmt const_locals =
52
  let pp_var fmt v =
53
    if List.mem v const_locals
54
    then
55
      Format.fprintf fmt "%s ## %s" inst v.var_id
56
    else 
57
      Format.fprintf fmt "%s" v.var_id in
58
  Format.fprintf fmt "%a%t"
59
    (Utils.fprintf_list ~sep:";\\@," (print_constant m pp_var)) const_locals
60
    (Utils.pp_final_char_if_non_empty ";\\@," const_locals)
61

  
62
let print_static_declare_instance (m, attr, inst) const_locals fmt (i, (n, static)) =
63
  let pp_var fmt v =
64
    if List.mem v const_locals
65
    then
66
      Format.fprintf fmt "%s ## %s" inst v.var_id
67
    else 
68
      Format.fprintf fmt "%s" v.var_id in
69
  let values = List.map (Machine_code.value_of_dimension m) static in
40 70
  fprintf fmt "%a(%s, %a%t%s)"
41
    pp_machine_static_declare_name (node_name m)
71
    pp_machine_static_declare_name (node_name n)
42 72
    attr
43
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
73
    (Utils.fprintf_list ~sep:", " (print_static_val pp_var)) values
44 74
    (Utils.pp_final_char_if_non_empty ", " static)
45 75
    i
46 76

  
47
let print_static_declare_macro fmt m =
77
let print_static_declare_macro fmt (m, attr, inst) =
78
  let const_locals = List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in
48 79
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
49
  let inst = mk_instance m in
50
  let attr = mk_attribute m in
51
  fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%s %a %s;\\@,%a%t%a;@,@]"
80
  fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%a%s %a %s;\\@,%a%t%a;@,@]"
52 81
    pp_machine_static_declare_name m.mname.node_id
53 82
    attr
54 83
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
55 84
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
56 85
    inst
86
    (* constants *)
87
    (print_static_constant (m, attr, inst)) const_locals
57 88
    attr
58 89
    pp_machine_memtype_name m.mname.node_id
59 90
    inst
60
    (Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem
91
    (Utils.fprintf_list ~sep:";\\@," (pp_c_decl_local_var m)) array_mem
61 92
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
62 93
    (Utils.fprintf_list ~sep:";\\@,"
63 94
       (fun fmt (i',m') ->
64
	 let path = sprintf "inst ## _%s" i' in
95
	 let path = sprintf "%s ## _%s" inst i' in
65 96
	 fprintf fmt "%a"
66
	   (print_static_declare_instance attr) (path,m')
97
	   (print_static_declare_instance (m, attr, inst) const_locals) (path, m')
67 98
       )) m.minstances
68 99

  
69 100
      
......
73 104
(* Allocation of a node struct:
74 105
   - if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct)
75 106
*)
76
let print_static_link_macro fmt m =
107
let print_static_link_macro fmt (m, attr, inst) =
77 108
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
78
  fprintf fmt "@[<v>@[<v 2>#define %a(inst) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
109
  fprintf fmt "@[<v>@[<v 2>#define %a(%s) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
79 110
    pp_machine_static_link_name m.mname.node_id
111
    inst
80 112
    (Utils.fprintf_list ~sep:";\\@,"
81 113
       (fun fmt v ->
82
	 fprintf fmt "inst._reg.%s = (%a*) &%s"
114
	 fprintf fmt "%s._reg.%s = (%a*) &%s"
115
	   inst
83 116
	   v.var_id
84 117
           (fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v
85 118
	   v.var_id
......
87 120
    (Utils.pp_final_char_if_non_empty ";\\@," array_mem)
88 121
    (Utils.fprintf_list ~sep:";\\@,"
89 122
       (fun fmt (i',m') ->
90
	 let path = sprintf "inst ## _%s" i' in
91
	 fprintf fmt "%a;\\@,inst.%s = &%s"
123
	 let path = sprintf "%s ## _%s" inst i' in
124
	 fprintf fmt "%a;\\@,%s.%s = &%s"
92 125
	   print_static_link_instance (path,m')
126
	   inst
93 127
	   i'
94 128
	   path
95 129
       )) m.minstances
96
      
97
let print_static_alloc_macro fmt m =
98
  fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@."
130

  
131
let print_static_alloc_macro fmt (m, attr, inst) =
132
  fprintf fmt "@[<v>@[<v 2>#define %a(%s, %a%t%s)\\@,%a(%s, %a%t%s);\\@,%a(%s);@]@,@]@."
99 133
    pp_machine_static_alloc_name m.mname.node_id
134
    attr
100 135
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
101 136
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
137
    inst
102 138
    pp_machine_static_declare_name m.mname.node_id
139
    attr
103 140
    (Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
104 141
    (Utils.pp_final_char_if_non_empty ", " m.mstatic)
142
    inst
105 143
    pp_machine_static_link_name m.mname.node_id
144
    inst
106 145

  
107
 
108 146
let print_machine_decl fmt m =
109 147
  Mod.print_machine_decl_prefix fmt m;
110 148
  if fst (get_stateless_status m) then
......
117 155
    begin
118 156
      (* Static allocation *)
119 157
      if !Options.static_mem
120
      then (
121
	fprintf fmt "%a@.%a@.%a@."
122
	  print_static_declare_macro m
123
	  print_static_link_macro m
124
	  print_static_alloc_macro m
125
      )
126
      else ( 
158
      then
159
	begin
160
	  let inst = mk_instance m in
161
	  let attr = mk_attribute m in
162
	  fprintf fmt "%a@.%a@.%a@."
163
	    print_static_declare_macro (m, attr, inst)
164
	    print_static_link_macro (m, attr, inst)
165
	    print_static_alloc_macro (m, attr, inst)
166
	end
167
      else
168
	begin 
127 169
        (* Dynamic allocation *)
128
	fprintf fmt "extern %a;@.@."
129
	  print_alloc_prototype (m.mname.node_id, m.mstatic)
130
      );
170
	  fprintf fmt "extern %a;@.@."
171
	    print_alloc_prototype (m.mname.node_id, m.mstatic)
172
	end;
131 173
      let self = mk_self m in
132 174
      fprintf fmt "extern %a;@.@."
133 175
	(print_reset_prototype self) (m.mname.node_id, m.mstatic);
......
148 190
      then
149 191
	begin
150 192
	  (* Static allocation *)
193
	  let inst = mk_instance m in
194
	  let attr = mk_attribute m in
151 195
	  fprintf fmt "%a@.%a@.%a@."
152
		  print_static_declare_macro m
153
		  print_static_link_macro m
154
		  print_static_alloc_macro m
196
		  print_static_declare_macro (m, attr, inst)
197
		  print_static_link_macro (m, attr, inst)
198
		  print_static_alloc_macro (m, attr, inst)
155 199
	end
156 200
      else
157 201
	begin 

Also available in: Unified diff