Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_src.ml @ 01d48bb0

History | View | Annotate | Download (19.8 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
open C_backend_common
17

    
18
module type MODIFIERS_SRC =
19
sig
20
end
21

    
22
module EmptyMod =
23
struct
24
end
25

    
26
module Main = functor (Mod: MODIFIERS_SRC) -> 
27
struct
28

    
29
(********************************************************************************************)
30
(*                    Instruction Printing functions                                        *)
31
(********************************************************************************************)
32

    
33
(* Computes the depth to which multi-dimension array assignments should be expanded.
34
   It equals the maximum number of nested static array constructions accessible from root [v].
35
*)
36
let rec expansion_depth v =
37
 match v with
38
 | Cst (Const_array cl) -> 1 + List.fold_right (fun c -> max (expansion_depth (Cst c))) cl 0
39
 | Cst _
40
 | LocalVar _
41
 | StateVar _  -> 0
42
 | Fun (_, vl) -> List.fold_right (fun v -> max (expansion_depth v)) vl 0
43
 | Array vl    -> 1 + List.fold_right (fun v -> max (expansion_depth v)) vl 0
44
 | Access (v, i) -> max 0 (expansion_depth v - 1)
45
 | Power (v, n)  -> 0 (*1 + expansion_depth v*)
46

    
47
let rec merge_static_loop_profiles lp1 lp2 =
48
  match lp1, lp2 with
49
  | []      , _        -> lp2
50
  | _       , []       -> lp1
51
  | p1 :: q1, p2 :: q2 -> (p1 || p2) :: merge_static_loop_profiles q1 q2
52

    
53
(* Returns a list of bool values, indicating whether the indices must be static or not *)
54
let rec static_loop_profile v =
55
 match v with
56
 | Cst (Const_array cl) ->
57
   List.fold_right (fun c lp -> merge_static_loop_profiles lp (static_loop_profile (Cst c))) cl []
58
 | Cst _
59
 | LocalVar _
60
 | StateVar _  -> []
61
 | Fun (_, vl) -> List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl []
62
 | Array vl    -> true :: List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl []
63
 | Access (v, i) -> (match (static_loop_profile v) with [] -> [] | _ :: q -> q)
64
 | Power (v, n)  -> false :: static_loop_profile v
65

    
66
let rec is_const_index v =
67
  match v with
68
  | Cst (Const_int _) -> true
69
  | Fun (_, vl)       -> List.for_all is_const_index vl
70
  | _                 -> false
71

    
72
type loop_index = LVar of ident | LInt of int ref | LAcc of value_t
73
(*
74
let rec value_offsets v offsets =
75
 match v, offsets with
76
 | _                        , []          -> v
77
 | Power (v, n)             , _ :: q      -> value_offsets v q
78
 | Array vl                 , LInt r :: q -> value_offsets (List.nth vl !r) q
79
 | Cst (Const_array cl)     , LInt r :: q -> value_offsets (Cst (List.nth cl !r)) q
80
 | Fun (f, vl)              , _           -> Fun (f, List.map (fun v -> value_offsets v offsets) vl)
81
 | _                        , LInt r :: q -> value_offsets (Access (v, Cst (Const_int !r))) q
82
 | _                        , LVar i :: q -> value_offsets (Access (v, LocalVar i)) q
83
*)
84
(* Computes the list of nested loop variables together with their dimension bounds.
85
   - LInt r stands for loop expansion (no loop variable, but int loop index)
86
   - LVar v stands for loop variable v
87
*)
88
let rec mk_loop_variables m ty depth =
89
 match (Types.repr ty).Types.tdesc, depth with
90
 | Types.Tarray (d, ty'), 0       ->
91
   let v = mk_loop_var m () in
92
   (d, LVar v) :: mk_loop_variables m ty' 0
93
 | Types.Tarray (d, ty'), _       ->
94
   let r = ref (-1) in
95
   (d, LInt r) :: mk_loop_variables m ty' (depth - 1)
96
 | _                    , 0       -> []
97
 | _                              -> assert false
98

    
99
let reorder_loop_variables loop_vars =
100
  let (int_loops, var_loops) = 
101
    List.partition (function (d, LInt _) -> true | _ -> false) loop_vars 
102
  in
103
  var_loops @ int_loops
104
    
105
(* Prints a one loop variable suffix for arrays *)
106
let pp_loop_var fmt lv =
107
 match snd lv with
108
 | LVar v -> fprintf fmt "[%s]" v
109
 | LInt r -> fprintf fmt "[%d]" !r
110
 | LAcc i -> fprintf fmt "[%a]" pp_val i
111

    
112
(* Prints a suffix of loop variables for arrays *)
113
let pp_suffix fmt loop_vars =
114
 Utils.fprintf_list ~sep:"" pp_loop_var fmt loop_vars
115

    
116
(* Prints a [value] indexed by the suffix list [loop_vars] *)
117
let rec pp_value_suffix self loop_vars pp_value fmt value =
118
 match loop_vars, value with
119
 | (_, LInt r) :: q, Array vl      ->
120
   pp_value_suffix self q pp_value fmt (List.nth vl !r)
121
 | _           :: q, Power (v, n)  ->
122
   pp_value_suffix self q pp_value fmt v
123
 | _               , Fun (n, vl)   ->
124
   Basic_library.pp_c n (pp_value_suffix self loop_vars pp_value) fmt vl
125
 | _               , Access (v, i) ->
126
   pp_value_suffix self ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
127
 | _               , _             ->
128
   let pp_var_suffix fmt v = fprintf fmt "%a%a" pp_value v pp_suffix loop_vars in
129
   pp_c_val self pp_var_suffix fmt value
130

    
131
(* type_directed assignment: array vs. statically sized type
132
   - [var_type]: type of variable to be assigned
133
   - [var_name]: name of variable to be assigned
134
   - [value]: assigned value
135
   - [pp_var]: printer for variables
136
*)
137
(*
138
let pp_assign_rec pp_var var_type var_name value =
139
  match (Types.repr var_type).Types.tdesc, value with
140
  | Types.Tarray (d, ty'), Array vl     ->
141
    let szl = Utils.enumerate (Dimension.size_const_dimension d) in
142
    fprintf fmt "@[<v 2>{@,%a@]@,}"
143
      (Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl
144
  | Types.Tarray (d, ty'), Power (v, _) -> 
145
  | Types.Tarray (d, ty'), _            ->
146
  | _                    , _            ->
147
    fprintf fmt "%a = %a;" 
148
      pp_var var_name
149
      (pp_value_suffix self loop_vars pp_var) value
150
*)
151
let pp_assign m self pp_var fmt var_type var_name value =
152
  let depth = expansion_depth value in
153
(*Format.eprintf "pp_assign %a %a %a %d@." Types.print_ty var_type pp_val var_name pp_val value depth;*)
154
  let loop_vars = mk_loop_variables m var_type depth in
155
  let reordered_loop_vars = reorder_loop_variables loop_vars in
156
  let rec aux fmt vars =
157
    match vars with
158
    | [] ->
159
      fprintf fmt "%a = %a;" 
160
	(pp_value_suffix self loop_vars pp_var) var_name
161
	(pp_value_suffix self loop_vars pp_var) value
162
    | (d, LVar i) :: q ->
163
(*eprintf "pp_aux %a %s@." Dimension.pp_dimension d i;*)
164
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"
165
	i i i Dimension.pp_dimension d i
166
	aux q
167
    | (d, LInt r) :: q ->
168
(*eprintf "pp_aux %a %d@." Dimension.pp_dimension d (!r);*)
169
      let szl = Utils.enumerate (Dimension.size_const_dimension d) in
170
      fprintf fmt "@[<v 2>{@,%a@]@,}"
171
	(Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl
172
    | _ -> assert false
173
  in
174
  begin
175
    reset_loop_counter ();
176
    (*reset_addr_counter ();*)
177
    aux fmt reordered_loop_vars
178
  end
179

    
180
let pp_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list) =
181
 try (* stateful node instance *)
182
   let (n,_) = List.assoc i m.minstances in
183
   fprintf fmt "%a (%a%t%a%t%s->%s);"
184
     pp_machine_step_name (node_name n)
185
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
186
     (Utils.pp_final_char_if_non_empty ", " inputs) 
187
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs
188
     (Utils.pp_final_char_if_non_empty ", " outputs)
189
     self
190
     i
191
 with Not_found -> (* stateless node instance *)
192
   let (n,_) = List.assoc i m.mcalls in
193
   fprintf fmt "%a (%a%t%a);"
194
     pp_machine_step_name (node_name n)
195
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
196
     (Utils.pp_final_char_if_non_empty ", " inputs) 
197
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs 
198

    
199
let pp_machine_reset (m: machine_t) self fmt inst =
200
  let (node, static) =
201
    try
202
      List.assoc inst m.minstances
203
    with Not_found -> (Format.eprintf "pp_machine_reset %s %s %s: internal error@," m.mname.node_id self inst; raise Not_found) in
204
  fprintf fmt "%a(%a%t%s->%s);"
205
    pp_machine_reset_name (node_name node)
206
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
207
    (Utils.pp_final_char_if_non_empty ", " static)
208
    self inst
209

    
210
let has_c_prototype funname dependencies =
211
  let imported_node_opt = (* We select the last imported node with the name funname.
212
			       The order of evaluation of dependencies should be
213
			       compatible with overloading. (Not checked yet) *) 
214
      List.fold_left
215
	(fun res (Dep (_, _, decls, _)) -> 
216
	  match res with
217
	  | Some _ -> res
218
	  | None -> 
219
	    let matched = fun t -> match t.top_decl_desc with 
220
	      | ImportedNode nd -> nd.nodei_id = funname 
221
	      | _ -> false
222
	    in
223
	    if List.exists matched decls then (
224
	      match (List.find matched decls).top_decl_desc with
225
	      | ImportedNode nd -> Some nd
226
	      | _ -> assert false
227
	    )
228
	    else
229
	      None
230
	) None dependencies in
231
    match imported_node_opt with
232
    | None -> false
233
    | Some nd -> (match nd.nodei_prototype with Some "C" -> true | _ -> false)
234

    
235
let rec pp_conditional dependencies (m: machine_t) self fmt c tl el =
236
  fprintf fmt "@[<v 2>if (%a) {%t%a@]@,@[<v 2>} else {%t%a@]@,}"
237
    (pp_c_val self (pp_c_var_read m)) c
238
    (Utils.pp_newline_if_non_empty tl)
239
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) tl
240
    (Utils.pp_newline_if_non_empty el)
241
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) el
242

    
243
and pp_machine_instr dependencies (m: machine_t) self fmt instr =
244
  match instr with 
245
  | MReset i ->
246
    pp_machine_reset m self fmt i
247
  | MLocalAssign (i,v) ->
248
    pp_assign
249
      m self (pp_c_var_read m) fmt
250
      i.var_type (LocalVar i) v
251
  | MStateAssign (i,v) ->
252
    pp_assign
253
      m self (pp_c_var_read m) fmt
254
      i.var_type (StateVar i) v
255
  | MStep ([i0], i, vl) when Basic_library.is_internal_fun i  ->
256
    pp_machine_instr dependencies m self fmt (MLocalAssign (i0, Fun (i, vl)))
257
  | MStep ([i0], i, vl) when has_c_prototype i dependencies -> 
258
    fprintf fmt "%a = %s(%a);" 
259
      (pp_c_val self (pp_c_var_read m)) (LocalVar i0) 
260
      i
261
      (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) vl
262
  | MStep (il, i, vl) ->
263
    pp_instance_call m self fmt i vl il
264
  | MBranch (g,hl) ->
265
    if hl <> [] && let t = fst (List.hd hl) in t = tag_true || t = tag_false
266
    then (* boolean case, needs special treatment in C because truth value is not unique *)
267
	 (* may disappear if we optimize code by replacing last branch test with default *)
268
      let tl = try List.assoc tag_true  hl with Not_found -> [] in
269
      let el = try List.assoc tag_false hl with Not_found -> [] in
270
      pp_conditional dependencies m self fmt g tl el
271
    else (* enum type case *)
272
      fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
273
	(pp_c_val self (pp_c_var_read m)) g
274
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch dependencies m self)) hl
275

    
276
and pp_machine_branch dependencies m self fmt (t, h) =
277
  fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_c_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) h
278

    
279

    
280
(********************************************************************************************)
281
(*                         C file Printing functions                                        *)
282
(********************************************************************************************)
283

    
284
let print_const_def fmt cdecl =
285
  fprintf fmt "%a = %a;@." 
286
    (pp_c_type cdecl.const_id) cdecl.const_type
287
    pp_c_const cdecl.const_value 
288

    
289

    
290
let print_alloc_instance fmt (i, (m, static)) =
291
  fprintf fmt "_alloc->%s = %a (%a);@,"
292
    i
293
    pp_machine_alloc_name (node_name m)
294
    (Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static
295

    
296
let print_alloc_const fmt m =
297
  let const_locals = List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in
298
  fprintf fmt "%a%t"
299
    (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) const_locals
300
    (Utils.pp_final_char_if_non_empty ";@," const_locals)
301

    
302
let print_alloc_array fmt vdecl =
303
  let base_type = Types.array_base_type vdecl.var_type in
304
  let size_types = Types.array_type_multi_dimension vdecl.var_type in
305
  let size_type = Dimension.multi_dimension_product vdecl.var_loc size_types in
306
  fprintf fmt "_alloc->_reg.%s = (%a*) malloc((%a)*sizeof(%a));@,assert(_alloc->%s);@,"
307
    vdecl.var_id
308
    (pp_c_type "") base_type
309
    Dimension.pp_dimension size_type
310
    (pp_c_type "") base_type
311
    vdecl.var_id
312

    
313
let print_alloc_code fmt m =
314
  let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
315
  fprintf fmt "%a *_alloc;@,_alloc = (%a *) malloc(sizeof(%a));@,assert(_alloc);@,%a%areturn _alloc;"
316
    pp_machine_memtype_name m.mname.node_id
317
    pp_machine_memtype_name m.mname.node_id
318
    pp_machine_memtype_name m.mname.node_id
319
    (Utils.fprintf_list ~sep:"" print_alloc_array) array_mem
320
    (Utils.fprintf_list ~sep:"" print_alloc_instance) m.minstances
321

    
322
let print_stateless_code dependencies fmt m =
323
  let self = "__ERROR__" in
324
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc; top_decl_owner = ""; top_decl_itf = false })
325
  then
326
    (* C99 code *)
327
    fprintf fmt "@[<v 2>%a {@,%a%t@,%a%a%t%t@]@,}@.@."
328
      print_stateless_prototype (m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
329
      (* locals *)
330
      (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) m.mstep.step_locals
331
      (Utils.pp_final_char_if_non_empty ";@," m.mstep.step_locals)
332
      (* check assertions *)
333
      (pp_c_checks self) m
334
      (* instrs *)
335
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
336
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
337
      (fun fmt -> fprintf fmt "return;")
338
  else
339
    (* C90 code *)
340
    let (gen_locals, base_locals) = List.partition (fun v -> Types.is_generic_type v.var_type) m.mstep.step_locals in
341
    let gen_calls = List.map (fun e -> let (id, _, _) = call_of_expr e in mk_call_var_decl e.expr_loc id) m.mname.node_gencalls in
342
    fprintf fmt "@[<v 2>%a {@,%a%t@,%a%a%t%t@]@,}@.@."
343
      print_stateless_prototype (m.mname.node_id, (m.mstep.step_inputs@gen_locals@gen_calls), m.mstep.step_outputs)
344
      (* locals *)
345
      (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) base_locals
346
      (Utils.pp_final_char_if_non_empty ";" base_locals)
347
      (* check assertions *)
348
      (pp_c_checks self) m
349
      (* instrs *)
350
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
351
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
352
      (fun fmt -> fprintf fmt "return;")
353

    
354
let print_reset_code dependencies fmt m self =
355
  let const_locals = List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in
356
  fprintf fmt "@[<v 2>%a {@,%a%t@,%a%treturn;@]@,}@.@."
357
    (print_reset_prototype self) (m.mname.node_id, m.mstatic)
358
    (* constant locals decl *)
359
    (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) const_locals
360
    (Utils.pp_final_char_if_non_empty ";" const_locals)
361
    (* instrs *)
362
    (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.minit
363
    (Utils.pp_newline_if_non_empty m.minit)
364

    
365
let print_step_code dependencies fmt m self =
366
  if not (!Options.ansi && is_generic_node { top_decl_desc = Node m.mname; top_decl_loc = Location.dummy_loc; top_decl_owner = ""; top_decl_itf = false })
367
  then
368
    (* C99 code *)
369
    let array_mems = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
370
    fprintf fmt "@[<v 2>%a {@,%a%t%a%t@,%a%a%t%t@]@,}@.@."
371
      (print_step_prototype self) (m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
372
      (* locals *)
373
      (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) m.mstep.step_locals
374
      (Utils.pp_final_char_if_non_empty ";@," m.mstep.step_locals)
375
      (* array mems *)
376
      (Utils.fprintf_list ~sep:";@," (pp_c_decl_array_mem self)) array_mems
377
      (Utils.pp_final_char_if_non_empty ";@," array_mems)
378
      (* check assertions *)
379
      (pp_c_checks self) m
380
      (* instrs *)
381
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
382
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
383
      (fun fmt -> fprintf fmt "return;")
384
  else
385
    (* C90 code *)
386
    let (gen_locals, base_locals) = List.partition (fun v -> Types.is_generic_type v.var_type) m.mstep.step_locals in
387
    let gen_calls = List.map (fun e -> let (id, _, _) = call_of_expr e in mk_call_var_decl e.expr_loc id) m.mname.node_gencalls in
388
    fprintf fmt "@[<v 2>%a {@,%a%t@,%a%a%t%t@]@,}@.@."
389
      (print_step_prototype self) (m.mname.node_id, (m.mstep.step_inputs@gen_locals@gen_calls), m.mstep.step_outputs)
390
      (* locals *)
391
      (Utils.fprintf_list ~sep:";@," (pp_c_decl_local_var m)) base_locals
392
      (Utils.pp_final_char_if_non_empty ";" base_locals)
393
      (* check assertions *)
394
      (pp_c_checks self) m
395
      (* instrs *)
396
      (Utils.fprintf_list ~sep:"@," (pp_machine_instr dependencies m self)) m.mstep.step_instrs
397
      (Utils.pp_newline_if_non_empty m.mstep.step_instrs)
398
      (fun fmt -> fprintf fmt "return;")
399

    
400

    
401
(********************************************************************************************)
402
(*                     MAIN C file Printing functions                                       *)
403
(********************************************************************************************)
404

    
405
let print_machine dependencies fmt m =
406
  if fst (get_stateless_status m) then
407
    begin
408
      (* Step function *)
409
      print_stateless_code dependencies fmt m
410
    end
411
  else
412
    begin
413
      (* Alloc function, only if non static mode *)
414
      if (not !Options.static_mem) then  
415
	begin
416
	  fprintf fmt "@[<v 2>%a {@,%a%a@]@,}@.@."
417
	    print_alloc_prototype (m.mname.node_id, m.mstatic)
418
	    print_alloc_const m
419
	    print_alloc_code m;
420
	end;
421
      let self = mk_self m in
422
      (* Reset function *)
423
      print_reset_code dependencies fmt m self;
424
      (* Step function *)
425
      print_step_code dependencies fmt m self
426
    end
427

    
428

    
429
let print_lib_c source_fmt basename prog machines dependencies =
430

    
431
  fprintf source_fmt "#include <assert.h>@.";
432
  if not !Options.static_mem then
433
    begin
434
      fprintf source_fmt "#include <stdlib.h>@.";
435
    end;
436
  print_import_prototype source_fmt (Dep (true, basename, [], true (* assuming it is stateful *)));
437
  pp_print_newline source_fmt ();
438
  (* Print the svn version number and the supported C standard (C90 or C99) *)
439
  print_version source_fmt;
440
  (* Print the prototype of imported nodes *)
441
  fprintf source_fmt "/* Import dependencies */@.";
442
  fprintf source_fmt "@[<v>";
443
  List.iter (print_import_prototype source_fmt) dependencies;
444
  fprintf source_fmt "@]@.";
445
  (* Print consts *)
446
  fprintf source_fmt "/* Global constants (definitions) */@.";
447
  fprintf source_fmt "@[<v>";
448
  List.iter (fun c -> print_const_def source_fmt (const_of_top c)) (get_consts prog);
449
  fprintf source_fmt "@]@.";
450

    
451
  if not !Options.static_mem then
452
    begin
453
      fprintf source_fmt "/* External allocation function prototypes */@.";
454
      fprintf source_fmt "@[<v>";
455
      List.iter (print_extern_alloc_prototypes source_fmt) dependencies;
456
      fprintf source_fmt "@]@.";
457
      fprintf source_fmt "/* Node allocation function prototypes */@.";
458
      fprintf source_fmt "@[<v>";
459
      List.iter (fun m -> fprintf source_fmt "%a;@." print_alloc_prototype (m.mname.node_id, m.mstatic)) machines;
460
      fprintf source_fmt "@]@.";
461
    end;
462

    
463
  (* Print the struct definitions of all machines. *)
464
  fprintf source_fmt "/* Struct definitions */@.";
465
  fprintf source_fmt "@[<v>";
466
  List.iter (print_machine_struct source_fmt) machines;
467
  fprintf source_fmt "@]@.";
468
  pp_print_newline source_fmt ();
469
  (* Print nodes one by one (in the previous order) *)
470
  List.iter (print_machine dependencies source_fmt) machines;
471
 end
472

    
473
(* Local Variables: *)
474
(* compile-command:"make -C ../../.." *)
475
(* End: *)