Project

General

Profile

Revision 3b2bd83d src/backends/C/c_backend_main.ml

View differences:

src/backends/C/c_backend_main.ml
30 30
(*                         Main related functions                                           *)
31 31
(********************************************************************************************)
32 32

  
33
let print_get_input fmt v =
34
  match (Types.repr v.var_type).Types.tdesc with
35
    | Types.Tint -> fprintf fmt "_get_int(\"%s\")" v.var_id
36
    | Types.Tbool -> fprintf fmt "_get_bool(\"%s\")" v.var_id
37
    | Types.Treal -> fprintf fmt "_get_double(\"%s\")" v.var_id
38
    | _ -> assert false
33
let print_get_inputs fmt m =
34
  let pi fmt (v', v) =
35
  match (Types.unclock_type 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
39 50

  
40
let print_put_outputs fmt ol = 
41
  let po fmt o =
42
    match (Types.repr o.var_type).Types.tdesc with
43
    | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id
44
    | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id
45
    | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id
51
let print_put_outputs fmt m = 
52
  let po fmt (o', o) =
53
    match (Types.unclock_type 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
46 58
    | _ -> assert false
47 59
  in
48
  List.iter (fprintf fmt "@ %a;" po) ol
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_global_initialize fmt basename =
85
  let mNAME = file_to_module_name basename in
86
  fprintf fmt "@ /* Initialize global constants */@ %a();@ "
87
    pp_global_init_name mNAME
88

  
89
let print_global_clear fmt basename =
90
  let mNAME = file_to_module_name basename in
91
  fprintf fmt "@ /* Clear global constants */@ %a();@ "
92
    pp_global_clear_name mNAME
93

  
94
let print_main_initialize mname main_mem fmt m =
95
  if not (fst (get_stateless_status m))
96
  then
97
    fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
98
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
99
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
100
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
101
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
102
      pp_machine_init_name mname
103
      main_mem
104
  else
105
    fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ "
106
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
107
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
108
      (Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
109

  
110
let print_main_clear mname main_mem fmt m =
111
  if not (fst (get_stateless_status m))
112
  then
113
    fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
114
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
115
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
116
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
117
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
118
      pp_machine_clear_name mname
119
      main_mem
120
  else
121
    fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ "
122
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
123
      (Utils.pp_newline_if_non_empty m.mstep.step_inputs)
124
      (Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
125

  
126
let print_main_loop mname main_mem fmt m =
127
  let input_values =
128
    List.map (fun v -> mk_val (LocalVar v) v.var_type)
129
      m.mstep.step_inputs in
130
  begin
131
    fprintf fmt "@ ISATTY = isatty(0);@ ";
132
    fprintf fmt "@ /* Infinite loop */@ ";
133
    fprintf fmt "@[<v 2>while(1){@ ";
134
    fprintf fmt  "fflush(stdout);@ ";
135
    fprintf fmt "%a@ %t%a"
136
      print_get_inputs m
137
      (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
138
      print_put_outputs m
139
  end
49 140

  
50
let print_main_fun machines m fmt =
141
let print_main_code fmt basename m =
51 142
  let mname = m.mname.node_id in
52 143
  let main_mem =
53 144
    if (!Options.static_mem && !Options.main_node <> "")
54 145
    then "&main_mem"
55 146
    else "main_mem" in
56 147
  fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
57
  fprintf fmt "/* Declaration of inputs/outputs variables */@ ";
58
  List.iter 
59
    (fun v -> fprintf fmt "%a = %a;@ " (pp_c_type v.var_id) v.var_type pp_c_initialize v.var_type
60
    ) m.mstep.step_inputs;
61
  List.iter 
62
    (fun v -> fprintf fmt "%a = %a;@ " (pp_c_type v.var_id) v.var_type pp_c_initialize v.var_type
63
    ) m.mstep.step_outputs;
64
  fprintf fmt "@ /* Main memory allocation */@ ";
65
  if (!Options.static_mem && !Options.main_node <> "")
66
  then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
67
  else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
68
  fprintf fmt "@ /* Initialize the main memory */@ ";
69
  fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
70
  fprintf fmt "@ ISATTY = isatty(0);@ ";
71
  fprintf fmt "@ /* Infinite loop */@ ";
72
  fprintf fmt "@[<v 2>while(1){@ ";
73
  fprintf fmt  "fflush(stdout);@ ";
74
  List.iter 
75
    (fun v -> fprintf fmt "%s = %a;@ "
76
      v.var_id
77
      print_get_input v
78
    ) m.mstep.step_inputs;
79
  (match m.mstep.step_outputs with
80
    (* | [] -> ( *)
81
    (*   fprintf fmt "%a(%a%t%s);@ "  *)
82
    (* 	pp_machine_step_name mname *)
83
    (* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
84
    (* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
85
    (* 	main_mem *)
86
    (* ) *)
87
    (* | [o] -> ( *)
88
    (*   fprintf fmt "%s = %a(%a%t%a, %s);%a" *)
89
    (* 	o.var_id *)
90
    (* 	pp_machine_step_name mname *)
91
    (* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
92
    (* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
93
    (* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
94
    (* 	main_mem *)
95
    (* 	print_put_outputs [o]) *)
96
    | _ -> (
97
      fprintf fmt "%a(%a%t%a, %s);%a"
98
	pp_machine_step_name mname
99
	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs
100
	(Utils.pp_final_char_if_non_empty ", " m.mstep.step_inputs)
101
	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs
102
	main_mem
103
	print_put_outputs m.mstep.step_outputs)
104
  );
105
  fprintf fmt "@]@ }@ ";
106
  fprintf fmt "return 1;";
148
  print_main_inout_declaration fmt m;
149
  print_main_memory_allocation mname main_mem fmt m;
150
  if !Options.mpfr then
151
    begin
152
      print_global_initialize fmt basename;
153
      print_main_initialize mname main_mem fmt m;
154
    end;
155
  print_main_loop mname main_mem fmt m;
156
  if Scopes.Plugin.is_active () then
157
    begin
158
      fprintf fmt "@ %t" Scopes.Plugin.pp 
159
    end;    
160
  fprintf fmt "@]@ }@ @ ";
161
  if !Options.mpfr then
162
    begin
163
      print_main_clear mname main_mem fmt m;
164
      print_global_clear fmt basename;
165
    end;
166
  fprintf fmt "@ return 1;";
107 167
  fprintf fmt "@]@ }@."       
108 168

  
109 169
let print_main_header fmt =
......
118 178

  
119 179
  (* Print the svn version number and the supported C standard (C90 or C99) *)
120 180
  print_version main_fmt;
121
  print_main_fun machines main_machine main_fmt
181
  print_main_code main_fmt basename main_machine
122 182
end  
123 183

  
124 184
(* Local Variables: *)

Also available in: Unified diff