Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_common.ml @ 53206908

History | View | Annotate | Download (20.7 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Format
13
open LustreSpec
14
open Corelang
15
open Machine_code
16

    
17

    
18
let print_version fmt =
19
  Format.fprintf fmt 
20
    "/* @[<v>C code generated by %s@,SVN version number %s@,Code is %s compliant */@,@]@."
21
    (Filename.basename Sys.executable_name) 
22
    Version.number 
23
    (if !Options.ansi then "ANSI C90" else "C99")
24
 
25
(* Generation of a non-clashing name for the self memory variable (for step and reset functions) *)
26
let mk_self m =
27
  let used name =
28
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
29
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_outputs)
30
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_locals)
31
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
32
  mk_new_name used "self"
33

    
34
(* Generation of a non-clashing name for the instance variable of static allocation macro *)
35
let mk_instance m =
36
  let used name =
37
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
38
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
39
  mk_new_name used "inst"
40

    
41
(* Generation of a non-clashing name for the attribute variable of static allocation macro *)
42
let mk_attribute m =
43
  let used name =
44
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
45
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
46
  mk_new_name used "attr"
47

    
48
let mk_call_var_decl loc id =
49
  { var_id = id;
50
    var_orig = false;
51
    var_dec_type = mktyp Location.dummy_loc Tydec_any;
52
    var_dec_clock = mkclock Location.dummy_loc Ckdec_any;
53
    var_dec_const = false;
54
    var_dec_value = None;
55
    var_type = Type_predef.type_arrow (Types.new_var ()) (Types.new_var ());
56
    var_clock = Clocks.new_var true;
57
    var_loc = loc }
58

    
59
(* counter for loop variable creation *)
60
let loop_cpt = ref (-1)
61

    
62
let reset_loop_counter () =
63
 loop_cpt := -1
64

    
65
let mk_loop_var m () =
66
  let vars = m.mstep.step_inputs@m.mstep.step_outputs@m.mstep.step_locals@m.mmemory in
67
  let rec aux () =
68
    incr loop_cpt;
69
    let s = Printf.sprintf "__%s_%d" "i" !loop_cpt in
70
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
71
  in aux ()
72
(*
73
let addr_cpt = ref (-1)
74

    
75
let reset_addr_counter () =
76
 addr_cpt := -1
77

    
78
let mk_addr_var m var =
79
  let vars = m.mmemory in
80
  let rec aux () =
81
    incr addr_cpt;
82
    let s = Printf.sprintf "%s_%s_%d" var "addr" !addr_cpt in
83
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
84
  in aux ()
85
*)
86
let pp_machine_memtype_name fmt id = fprintf fmt "struct %s_mem" id
87
let pp_machine_regtype_name fmt id = fprintf fmt "struct %s_reg" id
88
let pp_machine_alloc_name fmt id = fprintf fmt "%s_alloc" id
89
let pp_machine_static_declare_name fmt id = fprintf fmt "%s_DECLARE" id
90
let pp_machine_static_link_name fmt id = fprintf fmt "%s_LINK" id
91
let pp_machine_static_alloc_name fmt id = fprintf fmt "%s_ALLOC" id
92
let pp_machine_reset_name fmt id = fprintf fmt "%s_reset" id
93
let pp_machine_init_name fmt id = fprintf fmt "%s_init" id
94
let pp_machine_clear_name fmt id = fprintf fmt "%s_clear" id
95
let pp_machine_step_name fmt id = fprintf fmt "%s_step" id
96

    
97
let rec pp_c_dimension fmt dim =
98
  match dim.Dimension.dim_desc with
99
  | Dimension.Dident id       ->
100
    fprintf fmt "%s" id
101
  | Dimension.Dint i          ->
102
    fprintf fmt "%d" i
103
  | Dimension.Dbool b         ->
104
    fprintf fmt "%B" b
105
  | Dimension.Dite (i, t, e)  ->
106
    fprintf fmt "((%a)?%a:%a)"
107
       pp_c_dimension i pp_c_dimension t pp_c_dimension e
108
 | Dimension.Dappl (f, args) ->
109
     fprintf fmt "%a" (Basic_library.pp_c f pp_c_dimension) args
110
 | Dimension.Dlink dim' -> fprintf fmt "%a" pp_c_dimension dim'
111
 | Dimension.Dvar       -> fprintf fmt "_%s" (Utils.name_of_dimension dim.Dimension.dim_id)
112
 | Dimension.Dunivar    -> fprintf fmt "'%s" (Utils.name_of_dimension dim.Dimension.dim_id)
113

    
114
let is_basic_c_type t =
115
  match (Types.repr t).Types.tdesc with
116
  | Types.Tbool | Types.Treal | Types.Tint  -> true
117
  | _                                       -> false
118

    
119
let pp_basic_c_type fmt t =
120
  match (Types.repr t).Types.tdesc with
121
  | Types.Tbool                    -> fprintf fmt "_Bool"
122
  | Types.Treal when !Options.mpfr -> fprintf fmt "%s" Mpfr.mpfr_t
123
  | Types.Treal                    -> fprintf fmt "double"
124
  | Types.Tint                     -> fprintf fmt "int"
125
  | _ -> assert false (* Not a basic C type. Do not handle arrays or pointers *)
126

    
127
let pp_c_type var fmt t =
128
  let rec aux t pp_suffix =
129
    match (Types.repr t).Types.tdesc with
130
    | Types.Tclock t'       -> aux t' pp_suffix
131
    | Types.Tbool | Types.Tint | Types.Treal
132
                            -> fprintf fmt "%a %s%a" pp_basic_c_type t var pp_suffix ()
133
    | Types.Tarray (d, t')  ->
134
      let pp_suffix' fmt () = fprintf fmt "%a[%a]" pp_suffix () pp_c_dimension d in
135
      aux t' pp_suffix'
136
    | Types.Tstatic (_, t') -> fprintf fmt "const "; aux t' pp_suffix
137
    | Types.Tconst ty       -> fprintf fmt "%s %s" ty var
138
    | Types.Tarrow (_, _)   -> fprintf fmt "void (*%s)()" var
139
    | _                     -> eprintf "internal error: C_backend_common.pp_c_type %a@." Types.print_ty t; assert false
140
  in aux t (fun fmt () -> ())
141
(*
142
let rec pp_c_initialize fmt t = 
143
  match (Types.repr t).Types.tdesc with
144
  | Types.Tint -> pp_print_string fmt "0"
145
  | Types.Tclock t' -> pp_c_initialize fmt t'
146
  | Types.Tbool -> pp_print_string fmt "0" 
147
  | Types.Treal when not !Options.mpfr -> pp_print_string fmt "0."
148
  | Types.Tarray (d, t') when Dimension.is_dimension_const d ->
149
    fprintf fmt "{%a}"
150
      (Utils.fprintf_list ~sep:"," (fun fmt _ -> pp_c_initialize fmt t'))
151
      (Utils.duplicate 0 (Dimension.size_const_dimension d))
152
  | _ -> assert false
153
 *)
154

    
155
let pp_c_tag fmt t =
156
 pp_print_string fmt (if t = tag_true then "1" else if t = tag_false then "0" else t)
157

    
158
(* Prints a constant value *)
159
let rec pp_c_const fmt c =
160
  match c with
161
    | Const_int i     -> pp_print_int fmt i
162
    | Const_real (c,e,s)-> pp_print_string fmt s (* Format.fprintf fmt "%ie%i" c e*)
163
    (* | Const_float r   -> pp_print_float fmt r *)
164
    | Const_tag t     -> pp_c_tag fmt t
165
    | Const_array ca  -> fprintf fmt "{%a }" (Utils.fprintf_list ~sep:", " pp_c_const) ca
166
    | Const_struct fl -> fprintf fmt "{%a }" (Utils.fprintf_list ~sep:", " (fun fmt (f, c) -> pp_c_const fmt c)) fl
167
    | Const_string _ -> assert false (* string occurs in annotations not in C *)
168

    
169
(* Prints a value expression [v], with internal function calls only.
170
   [pp_var] is a printer for variables (typically [pp_c_var_read]),
171
   but an offset suffix may be added for array variables
172
*)
173
let rec pp_c_val self pp_var fmt v =
174
  match v.value_desc with
175
  | Cst c         -> pp_c_const fmt c
176
  | Array vl      -> fprintf fmt "{%a}" (Utils.fprintf_list ~sep:", " (pp_c_val self pp_var)) vl
177
  | Access (t, i) -> fprintf fmt "%a[%a]" (pp_c_val self pp_var) t (pp_c_val self pp_var) i
178
  | Power (v, n)  -> assert false
179
  | LocalVar v    -> pp_var fmt v
180
  | StateVar v    ->
181
    (* array memory vars are represented by an indirection to a local var with the right type,
182
       in order to avoid casting everywhere. *)
183
    if Types.is_array_type v.var_type && not (Types.is_real_type v.var_type && !Options.mpfr)
184
    then fprintf fmt "%a" pp_var v
185
    else fprintf fmt "%s->_reg.%a" self pp_var v
186
  | Fun (n, vl)   -> Basic_library.pp_c n (pp_c_val self pp_var) fmt vl
187

    
188
(* Access to the value of a variable:
189
   - if it's not a scalar output, then its name is enough
190
   - otherwise, dereference it (it has been declared as a pointer,
191
     despite its scalar Lustre type)
192
   - moreover, dereference memory array variables.
193
*)
194
let pp_c_var_read m fmt id =
195
  (* mpfr_t is a static array, not treated as general arrays *)
196
  if Types.is_address_type id.var_type
197
  then
198
    if is_memory m id && not (Types.is_real_type id.var_type && !Options.mpfr)
199
    then fprintf fmt "(*%s)" id.var_id
200
    else fprintf fmt "%s" id.var_id
201
  else
202
    if is_output m id
203
    then fprintf fmt "*%s" id.var_id
204
    else fprintf fmt "%s" id.var_id
205

    
206
(* Addressable value of a variable, the one that is passed around in calls:
207
   - if it's not a scalar non-output, then its name is enough
208
   - otherwise, reference it (it must be passed as a pointer,
209
     despite its scalar Lustre type)
210
*)
211
let pp_c_var_write m fmt id =
212
  if Types.is_address_type id.var_type
213
  then
214
    fprintf fmt "%s" id.var_id
215
  else
216
    if is_output m id
217
    then
218
      fprintf fmt "%s" id.var_id
219
    else
220
      fprintf fmt "&%s" id.var_id
221

    
222
(* Declaration of an input variable:
223
   - if its type is array/matrix/etc, then declare it as a mere pointer,
224
     in order to cope with unknown/parametric array dimensions, 
225
     as it is the case for generics
226
*)
227
let pp_c_decl_input_var fmt id =
228
  if !Options.ansi && Types.is_address_type id.var_type
229
  then pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type)
230
  else pp_c_type id.var_id fmt id.var_type
231

    
232
(* Declaration of an output variable:
233
   - if its type is scalar, then pass its address
234
   - if its type is array/matrix/struct/etc, then declare it as a mere pointer,
235
     in order to cope with unknown/parametric array dimensions, 
236
     as it is the case for generics
237
*)
238
let pp_c_decl_output_var fmt id =
239
  if (not !Options.ansi) && Types.is_address_type id.var_type
240
  then pp_c_type                  id.var_id  fmt id.var_type
241
  else pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type)
242

    
243
(* Declaration of a local/mem variable:
244
   - if it's an array/matrix/etc, its size(s) should be
245
     known in order to statically allocate memory, 
246
     so we print the full type
247
*)
248
let pp_c_decl_local_var m fmt id =
249
  if id.var_dec_const
250
  then
251
    Format.fprintf fmt "%a = %a"
252
      (pp_c_type id.var_id) id.var_type
253
      (pp_c_val "" (pp_c_var_read m)) (get_const_assign m id)
254
  else
255
    Format.fprintf fmt "%a"
256
      (pp_c_type id.var_id) id.var_type
257

    
258
let pp_c_decl_array_mem self fmt id =
259
  fprintf fmt "%a = (%a) (%s->_reg.%s)"
260
    (pp_c_type (sprintf "(*%s)" id.var_id)) id.var_type
261
    (pp_c_type "(*)") id.var_type
262
    self
263
    id.var_id
264

    
265
(* Declaration of a struct variable:
266
   - if it's an array/matrix/etc, we declare it as a pointer
267
*)
268
let pp_c_decl_struct_var fmt id =
269
  if Types.is_array_type id.var_type
270
  then pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type)
271
  else pp_c_type                  id.var_id  fmt id.var_type
272

    
273
let pp_c_decl_instance_var fmt (name, (node, static)) = 
274
  fprintf fmt "%a *%s" pp_machine_memtype_name (node_name node) name
275

    
276
let pp_c_checks self fmt m =
277
  Utils.fprintf_list ~sep:"" 
278
    (fun fmt (loc, check) -> 
279
      fprintf fmt 
280
	"@[<v>%a@,assert (%a);@]@," 
281
	Location.pp_c_loc loc
282
	(pp_c_val self (pp_c_var_read m)) check
283
    ) 
284
    fmt 
285
    m.mstep.step_checks
286

    
287
(********************************************************************************************)
288
(*                       Struct Printing functions                                          *)
289
(********************************************************************************************)
290

    
291
let pp_registers_struct fmt m =
292
  if m.mmemory <> []
293
  then
294
    fprintf fmt "@[%a {@[<v>%a;@ @]}@] _reg; "
295
      pp_machine_regtype_name m.mname.node_id
296
      (Utils.fprintf_list ~sep:";@ " pp_c_decl_struct_var) m.mmemory
297
  else
298
    ()
299

    
300
let print_machine_struct fmt m =
301
  if fst (get_stateless_status m) then
302
    begin
303
    end
304
  else
305
    begin
306
      (* Define struct *)
307
      fprintf fmt "@[%a {@[<v>%a%t%a%t@]};@]@."
308
	pp_machine_memtype_name m.mname.node_id
309
	pp_registers_struct m
310
	(Utils.pp_final_char_if_non_empty "@ " m.mmemory)
311
	(Utils.fprintf_list ~sep:";@ " pp_c_decl_instance_var) m.minstances
312
	(Utils.pp_final_char_if_non_empty ";@ " m.minstances)
313
    end
314

    
315
let print_machine_struct_from_header fmt inode =
316
  if inode.nodei_stateless then
317
    begin
318
    end
319
  else
320
    begin
321
      (* Declare struct *)
322
      fprintf fmt "@[%a;@]@."
323
	pp_machine_memtype_name inode.nodei_id
324
    end
325

    
326
(********************************************************************************************)
327
(*                      Prototype Printing functions                                        *)
328
(********************************************************************************************)
329

    
330
let print_alloc_prototype fmt (name, static) =
331
  fprintf fmt "%a * %a (%a)"
332
    pp_machine_memtype_name name
333
    pp_machine_alloc_name name
334
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) static
335

    
336
let print_reset_prototype self fmt (name, static) =
337
  fprintf fmt "void %a (@[<v>%a%t%a *%s@])"
338
    pp_machine_reset_name name
339
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) static
340
    (Utils.pp_final_char_if_non_empty ",@," static) 
341
    pp_machine_memtype_name name
342
    self
343

    
344
let print_init_prototype self fmt (name, static) =
345
  fprintf fmt "void %a (@[<v>%a%t%a *%s@])"
346
    pp_machine_init_name name
347
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) static
348
    (Utils.pp_final_char_if_non_empty ",@," static) 
349
    pp_machine_memtype_name name
350
    self
351

    
352
let print_clear_prototype self fmt (name, static) =
353
  fprintf fmt "void %a (@[<v>%a%t%a *%s@])"
354
    pp_machine_clear_name name
355
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) static
356
    (Utils.pp_final_char_if_non_empty ",@," static) 
357
    pp_machine_memtype_name name
358
    self
359

    
360
let print_stateless_prototype fmt (name, inputs, outputs) =
361
  fprintf fmt "void %a (@[<v>@[%a%t@]@,@[%a@]@,@])"
362
    pp_machine_step_name name
363
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs
364
    (Utils.pp_final_char_if_non_empty ",@ " inputs) 
365
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_output_var) outputs
366

    
367
let print_step_prototype self fmt (name, inputs, outputs) =
368
  fprintf fmt "void %a (@[<v>@[%a%t@]@,@[%a@]%t@[%a *%s@]@])"
369
    pp_machine_step_name name
370
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs
371
    (Utils.pp_final_char_if_non_empty ",@ " inputs) 
372
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_output_var) outputs
373
    (Utils.pp_final_char_if_non_empty ",@," outputs) 
374
    pp_machine_memtype_name name
375
    self
376

    
377
let print_stateless_C_prototype fmt (name, inputs, outputs) =
378
  let output = 
379
    match outputs with
380
    | [hd] -> hd
381
    | _ -> assert false
382
  in
383
  fprintf fmt "%a %s (@[<v>@[%a@]@,@])"
384
    pp_basic_c_type output.var_type
385
    name
386
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs
387
    
388
    
389

    
390
let print_import_prototype fmt (Dep (_, s, _, _)) =
391
  fprintf fmt "#include \"%s.h\"@," s
392

    
393
let print_import_alloc_prototype fmt (Dep (_, s, _, stateful)) =
394
  if stateful then
395
    fprintf fmt "#include \"%s_alloc.h\"@," s
396

    
397
let print_extern_alloc_prototypes fmt (Dep (_,_, header,_)) =
398
  List.iter (fun decl -> match decl.top_decl_desc with
399
  | ImportedNode ind when not ind.nodei_stateless ->
400
    let static = List.filter (fun v -> v.var_dec_const) ind.nodei_inputs
401
    in fprintf fmt "extern %a;@." print_alloc_prototype (ind.nodei_id, static)
402
  | _                -> ()
403
  ) header
404

    
405

    
406
let pp_c_main_var_input fmt id =  
407
  fprintf fmt "%s" id.var_id
408

    
409
let pp_c_main_var_output fmt id =
410
  if Types.is_address_type id.var_type
411
  then
412
    fprintf fmt "%s" id.var_id
413
  else
414
    fprintf fmt "&%s" id.var_id
415

    
416
let pp_main_call mname self fmt m (inputs: value_t list) (outputs: var_decl list) =
417
  if m.mmemory = []
418
  then
419
    fprintf fmt "%a (%a%t%a);"
420
      pp_machine_step_name mname
421
      (Utils.fprintf_list ~sep:", " (pp_c_val self pp_c_main_var_input)) inputs
422
      (Utils.pp_final_char_if_non_empty ", " inputs) 
423
      (Utils.fprintf_list ~sep:", " pp_c_main_var_output) outputs
424
  else
425
    fprintf fmt "%a (%a%t%a%t%s);"
426
      pp_machine_step_name mname
427
      (Utils.fprintf_list ~sep:", " (pp_c_val self pp_c_main_var_input)) inputs
428
      (Utils.pp_final_char_if_non_empty ", " inputs) 
429
      (Utils.fprintf_list ~sep:", " pp_c_main_var_output) outputs
430
      (Utils.pp_final_char_if_non_empty ", " outputs)
431
      self
432

    
433
let pp_c_var m self pp_var fmt var =
434
  if is_memory m var
435
  then
436
    pp_c_val self pp_var fmt (mk_val (StateVar var) var.var_type)
437
  else
438
    pp_c_val self pp_var fmt (mk_val (LocalVar var) var.var_type)
439

    
440
let pp_array_suffix fmt loop_vars =
441
  Utils.fprintf_list ~sep:"" (fun fmt v -> fprintf fmt "[%s]" v) fmt loop_vars
442

    
443
(* type directed initialization: useless wrt the lustre compilation model,
444
   except for MPFR injection, where values are dynamically allocated
445
*)
446
let pp_initialize m self pp_var fmt var =
447
  let rec aux indices fmt typ =
448
    if Types.is_array_type typ
449
    then
450
      let dim = Types.array_type_dimension typ in
451
      let idx = mk_loop_var m () in
452
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"
453
	idx idx idx pp_c_dimension dim idx
454
	(aux (idx::indices)) (Types.array_element_type typ)
455
    else
456
      let pp_var_suffix fmt var =
457
	fprintf fmt "%a%a" (pp_c_var m self pp_var) var pp_array_suffix indices in
458
      Mpfr.pp_inject_init pp_var_suffix fmt var
459
  in
460
  if Types.is_real_type (Types.array_base_type var.var_type) && !Options.mpfr
461
  then
462
    begin
463
      reset_loop_counter ();
464
      aux [] fmt var.var_type
465
    end
466

    
467
(* type directed clear: useless wrt the lustre compilation model,
468
   except for MPFR injection, where values are dynamically allocated
469
*)
470
let pp_clear m self pp_var fmt var =
471
  let rec aux indices fmt typ =
472
    if Types.is_array_type typ
473
    then
474
      let dim = Types.array_type_dimension typ in
475
      let idx = mk_loop_var m () in
476
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"
477
	idx idx idx pp_c_dimension dim idx
478
	(aux (idx::indices)) (Types.array_element_type typ)
479
    else
480
      let pp_var_suffix fmt var =
481
	fprintf fmt "%a%a" (pp_c_var m self pp_var) var pp_array_suffix indices in
482
      Mpfr.pp_inject_clear pp_var_suffix fmt var
483
  in
484
  if Types.is_real_type (Types.array_base_type var.var_type) && !Options.mpfr
485
  then
486
    begin
487
      reset_loop_counter ();
488
      aux [] fmt var.var_type
489
    end
490

    
491
let pp_call m self pp_read pp_write fmt i (inputs: value_t list) (outputs: var_decl list) =
492
 try (* stateful node instance *)
493
   let (n,_) = List.assoc i m.minstances in
494
   fprintf fmt "%a (%a%t%a%t%s->%s);"
495
     pp_machine_step_name (node_name n)
496
     (Utils.fprintf_list ~sep:", " (pp_c_val self pp_read)) inputs
497
     (Utils.pp_final_char_if_non_empty ", " inputs) 
498
     (Utils.fprintf_list ~sep:", " pp_write) outputs
499
     (Utils.pp_final_char_if_non_empty ", " outputs)
500
     self
501
     i
502
 with Not_found -> (* stateless node instance *)
503
   let (n,_) = List.assoc i m.mcalls in
504
   fprintf fmt "%a (%a%t%a);"
505
     pp_machine_step_name (node_name n)
506
     (Utils.fprintf_list ~sep:", " (pp_c_val self pp_read)) inputs
507
     (Utils.pp_final_char_if_non_empty ", " inputs) 
508
     (Utils.fprintf_list ~sep:", " pp_write) outputs 
509

    
510
let pp_basic_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list) =
511
  pp_call m self (pp_c_var_read m) (pp_c_var_write m) fmt i inputs outputs
512
(*
513
 try (* stateful node instance *)
514
   let (n,_) = List.assoc i m.minstances in
515
   fprintf fmt "%a (%a%t%a%t%s->%s);"
516
     pp_machine_step_name (node_name n)
517
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
518
     (Utils.pp_final_char_if_non_empty ", " inputs) 
519
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs
520
     (Utils.pp_final_char_if_non_empty ", " outputs)
521
     self
522
     i
523
 with Not_found -> (* stateless node instance *)
524
   let (n,_) = List.assoc i m.mcalls in
525
   fprintf fmt "%a (%a%t%a);"
526
     pp_machine_step_name (node_name n)
527
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
528
     (Utils.pp_final_char_if_non_empty ", " inputs) 
529
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs 
530
*)
531

    
532
let pp_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list) =
533
  let pp_offset pp_var indices fmt var =
534
    match indices with
535
    | [] -> fprintf fmt "%a" pp_var var
536
    | _  -> fprintf fmt "%a[%a]" pp_var var (Utils.fprintf_list ~sep:"][" pp_print_string) indices in
537
  let rec aux indices fmt typ =
538
    if Types.is_array_type typ
539
    then
540
      let dim = Types.array_type_dimension typ in
541
      let idx = mk_loop_var m () in
542
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"
543
	idx idx idx pp_c_dimension dim idx
544
	(aux (idx::indices)) (Types.array_element_type typ)
545
    else
546
      let pp_read  = pp_offset (pp_c_var_read  m) indices in
547
      let pp_write = pp_offset (pp_c_var_write m) indices in
548
      pp_call m self pp_read pp_write fmt i inputs outputs
549
  in
550
  begin
551
    reset_loop_counter ();
552
    aux [] fmt (List.hd inputs).value_type
553
  end
554

    
555
(* Local Variables: *)
556
(* compile-command:"make -C ../../.." *)
557
(* End: *)