Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_main.ml @ bdcbb2a1

History | View | Annotate | Download (6.83 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 LustreSpec
13
open Corelang
14
open Machine_code
15
open Format
16
open C_backend_common
17

    
18
module type MODIFIERS_MAINSRC =
19
sig
20
end
21

    
22
module EmptyMod =
23
struct
24
end
25

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

    
29
(********************************************************************************************)
30
(*                         Main related functions                                           *)
31
(********************************************************************************************)
32

    
33
let print_get_inputs fmt m =
34
  let pi fmt (v', v) =
35
  match (Types.repr v.var_type).Types.tdesc with
36
    | Types.Tint -> fprintf fmt "%s = _get_int(\"%s\")" v.var_id v'.var_id
37
    | Types.Tbool -> fprintf fmt "%s = _get_bool(\"%s\")" v.var_id v'.var_id
38
    | Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(\"%s\"), %i)" v.var_id v'.var_id (Mpfr.mpfr_prec ())
39
    | Types.Treal -> fprintf fmt "%s = _get_double(\"%s\")" v.var_id v'.var_id
40
    | _ ->
41
      begin
42
	Global.main_node := !Options.main_node;
43
	Format.eprintf "Code generation error: %a%a@."
44
	  pp_error Main_wrong_kind
45
	  Location.pp_loc v'.var_loc;
46
	raise (Error (v'.var_loc, Main_wrong_kind))
47
      end
48
  in
49
  List.iter2 (fun v' v -> fprintf fmt "@ %a;" pi (v', v)) m.mname.node_inputs m.mstep.step_inputs
50

    
51
let print_put_outputs fmt m = 
52
  let po fmt (o', o) =
53
    match (Types.repr o.var_type).Types.tdesc with
54
    | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o'.var_id o.var_id
55
    | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o'.var_id o.var_id
56
    | Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(\"%s\", mpfr_get_d(%s, %s))" o'.var_id o.var_id (Mpfr.mpfr_rnd ())
57
    | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o'.var_id o.var_id
58
    | _ -> assert false
59
  in
60
  List.iter2 (fun v' v -> fprintf fmt "@ %a;" po (v', v)) m.mname.node_outputs m.mstep.step_outputs
61

    
62
let print_main_inout_declaration fmt m =
63
  begin
64
    fprintf fmt "/* Declaration of inputs/outputs variables */@ ";
65
    List.iter 
66
      (fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type
67
      ) m.mstep.step_inputs;
68
    List.iter 
69
      (fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type
70
      ) m.mstep.step_outputs
71
  end
72

    
73
let print_main_memory_allocation mname main_mem fmt m =
74
  if not (fst (get_stateless_status m)) then
75
  begin
76
    fprintf fmt "@ /* Main memory allocation */@ ";
77
    if (!Options.static_mem && !Options.main_node <> "")
78
    then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
79
    else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
80
    fprintf fmt "@ /* Initialize the main memory */@ ";
81
    fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
82
  end
83

    
84
let print_main_initialize mname main_mem fmt m =
85
  if not (fst (get_stateless_status m)) 
86
  then
87
    fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
88
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
89
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
90
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
91
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
92
      pp_machine_init_name mname
93
      main_mem
94
  else
95
    fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ "
96
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
97
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
98
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
99

    
100
let print_main_clear mname main_mem fmt m =
101
  if not (fst (get_stateless_status m)) 
102
  then
103
    fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
104
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
105
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
106
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
107
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
108
      pp_machine_clear_name mname
109
      main_mem
110
  else
111
    fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ "
112
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
113
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
114
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
115

    
116
let print_main_loop mname main_mem fmt m =
117
  let input_values =
118
    List.map (fun v -> mk_val (LocalVar v) v.var_type)
119
      m.mstep.step_inputs in
120
  begin
121
    fprintf fmt "@ ISATTY = isatty(0);@ ";
122
    fprintf fmt "@ /* Infinite loop */@ ";
123
    fprintf fmt "@[<v 2>while(1){@ ";
124
    fprintf fmt  "fflush(stdout);@ ";
125
    fprintf fmt "%a@ %t%a"
126
      print_get_inputs m
127
      (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
128
      print_put_outputs m
129
  end
130

    
131
let print_main_code fmt m =
132
  let mname = m.mname.node_id in
133
  let main_mem =
134
    if (!Options.static_mem && !Options.main_node <> "")
135
    then "&main_mem"
136
    else "main_mem" in
137
  fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
138
  print_main_inout_declaration fmt m;
139
  print_main_memory_allocation mname main_mem fmt m;
140
  print_main_initialize mname main_mem fmt m;
141
  print_main_loop mname main_mem fmt m;
142

    
143
  Plugins.c_backend_main_loop_body_suffix fmt ();
144
  fprintf fmt "@]@ }@ @ ";
145
  print_main_clear mname main_mem fmt m;
146
  fprintf fmt "@ return 1;";
147
  fprintf fmt "@]@ }@."       
148

    
149
let print_main_header fmt =
150
  fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@." Version.include_path 
151

    
152

    
153
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
154
  print_main_header main_fmt;
155
  fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
156
  print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
157
  pp_print_newline main_fmt ();
158

    
159
  (* Print the svn version number and the supported C standard (C90 or C99) *)
160
  print_version main_fmt;
161
  print_main_code main_fmt main_machine
162
end  
163

    
164
(* Local Variables: *)
165
(* compile-command:"make -C ../../.." *)
166
(* End: *)