Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / java_backend.ml @ 22fe1c93

History | View | Annotate | Download (14.6 KB)

1
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23

    
24
(* This module is used for the lustre to Java compiler *)
25

    
26
open Format
27
open Utils
28
open LustreSpec
29
open Corelang
30
open Machine_code
31

    
32

    
33
(********************************************************************************************)
34
(*                     Basic      Printing functions                                        *)
35
(********************************************************************************************)
36

    
37
let pp_final_char_if_non_empty c l =
38
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "%s" c)
39

    
40
let pp_newline_if_non_empty l =
41
  (fun fmt -> match l with [] -> () | _ -> fprintf fmt "@,")
42

    
43
let pp_dimension fmt d =
44
  Printers.pp_expr fmt (expr_of_dimension d)
45

    
46
let pp_type fmt t = 
47
  match (Types.repr t).Types.tdesc with
48
    | Types.Tbool -> pp_print_string fmt "boolean" 
49
    | Types.Treal -> pp_print_string fmt "double" 
50
    | _ -> Types.print_ty fmt t
51

    
52
let pp_var fmt id = fprintf fmt "%a %s" pp_type id.var_type id.var_id
53

    
54
let pp_tag fmt t =
55
 pp_print_string fmt t
56

    
57
let rec pp_const fmt c =
58
  match c with
59
    | Const_int i -> pp_print_int fmt i
60
    | Const_real r -> pp_print_string fmt r
61
    | Const_float r -> pp_print_float fmt r
62
    | Const_tag t -> pp_tag fmt t
63
    | Const_array ca -> Format.fprintf fmt "{%a}" (Utils.fprintf_list ~sep:"," pp_const) ca
64

    
65
let rec pp_val m fmt v =
66
  match v with
67
    | Cst c -> pp_const fmt c
68
    | LocalVar v ->
69
      if List.exists (fun o -> o.var_id = v) m.mstep.step_outputs then
70
	fprintf fmt "*%s" v
71
      else
72
	pp_print_string fmt v
73
    | StateVar v -> fprintf fmt "%s" v
74
    | Fun (n, vl) -> if Basic_library.is_internal_fun n then
75
	Basic_library.pp_java n (pp_val m) fmt vl
76
      else
77
	fprintf fmt "%s (%a)" n (Utils.fprintf_list ~sep:", " (pp_val m)) vl
78

    
79
let pp_add_val m fmt i =
80
  if List.exists (fun o -> o.var_id = i) m.mstep.step_outputs
81
  then
82
    fprintf fmt "%s" i
83
  else
84
    fprintf fmt "&%s" i
85

    
86
(********************************************************************************************)
87
(*                    Instruction Printing functions                                        *)
88
(********************************************************************************************)
89
let get_output_of_machine machines i =
90
  try 
91
    let m = List.find (fun m -> m.mname.node_id = i) machines in
92
    m.mstep.step_outputs
93
  with Not_found -> assert false
94

    
95
let rec pp_machine_instr m machines instance_out_list fmt instr =
96
  match instr with
97
    | MReset i -> (
98
      match List.assoc i m.minstances with
99
	| "_arrow" -> fprintf fmt "%s = true;" i
100
	| _ -> fprintf fmt "%s.reset();" i
101
    )
102
    | MLocalAssign (i,v) -> (
103
      fprintf fmt "%s = %a;" 
104
	i (pp_val m) v
105
    )
106
    | MStateAssign (i,v) ->
107
      fprintf fmt "%s = %a;" i (pp_val m) v
108
    | MStep ([i0], i, vl) when Basic_library.is_internal_fun i ->
109
      fprintf fmt "%s = %a;" i0 (Basic_library.pp_java i (pp_val m)) vl    
110
    | MStep ([i0], i, [init; step]) when ((List.assoc i m.minstances) = "_arrow") -> (
111
      fprintf fmt "@[<v 2>if (%s) {@,%s = false;@,%s = %a;@]@,@[<v 2>} else {@,%s = %a;@]@,};@,"
112
	    i i i0 (pp_val m) init i0 (pp_val m) step
113
    )
114
    | MStep (il, i, vl) -> (
115
      let out = 
116
	try
117
	  List.assoc i instance_out_list 
118
	with Not_found -> (eprintf "impossible to find instance %s in the list@.@?" i; 
119
			   assert false) 
120
      in 
121
	  fprintf fmt "%s = %s.step (%a);@,"
122
    	    out i
123
     	    (Utils.fprintf_list ~sep:", " (pp_val m)) vl;
124
	  Utils.fprintf_list ~sep:"@," 
125
	    (fun fmt (o, oname) -> fprintf fmt "%s = %s.%s;" o out oname) fmt 
126
	    (List.map2 
127
	       (fun x y -> x, y.var_id) 
128
	       il 
129
	       (get_output_of_machine machines (List.assoc i m.minstances))
130
	    ) 
131
    ) 
132
      	
133
    | MBranch (g,hl) ->
134
      Format.fprintf fmt "@[<v 2>switch(%a) {@,%a@,}@]"
135
	(pp_val m) g
136
	(Utils.fprintf_list ~sep:"@," (pp_machine_branch m machines instance_out_list)) hl
137

    
138
and pp_machine_branch m machines instance_out_list fmt (t, h) =
139
  Format.fprintf fmt "@[<v 2>case %a:@,%a@,break;@]" pp_tag t (Utils.fprintf_list ~sep:"@," (pp_machine_instr m machines instance_out_list)) h
140

    
141
(********************************************************************************************)
142
(*                         Java file Printing functions                                        *)
143
(********************************************************************************************)
144

    
145
let get_class_name n = match n with "_arrow" -> "boolean" | _ -> String.capitalize n
146

    
147
let pp_local_fields visibility = 
148
  fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "%s %a;" visibility pp_var v) 
149

    
150
let pp_local_field_instances = 
151
  fprintf_list ~sep:"@," 
152
    (fun fmt (node_inst, node_type) -> fprintf fmt "protected %s %s;" 
153
      (get_class_name node_type) 
154
      node_inst
155
    ) 
156

    
157
let pp_output_constructor fmt outputs =
158
  fprintf fmt "@[<v 2>public Output(%a) {@,%a@]@,}"
159
    (fprintf_list ~sep:"; " pp_var) outputs
160
    (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "this.%s = %s;" v.var_id v.var_id)) outputs
161

    
162
let pp_output_class fmt step = 
163
  fprintf fmt "@[<v 2>public class Output {@,%a@,@,%a@]@,}@,"
164
    (pp_local_fields "public") step.step_outputs
165
    pp_output_constructor step.step_outputs
166

    
167
let pp_constructor fmt (name, instances) = 
168
  fprintf fmt "@[<v 2>public %s () {@,%a@]@,}@,"
169
    (String.capitalize name)
170
    (
171
      fprintf_list ~sep:"@," 
172
	(fun fmt (node_inst, node_type) -> 
173
	  match node_type with
174
	      "_arrow" -> fprintf fmt "%s = true;" node_inst
175
	    | _ -> fprintf fmt "%s = new %s();" node_inst (get_class_name node_type) 
176
	) 
177
    ) 
178
    instances
179

    
180
let pp_reset machines fmt m = 
181
  fprintf fmt "@[<v 2>public void reset () {@,%a@]@,}@,"
182
    (fprintf_list ~sep:"@," (pp_machine_instr m machines [])) m.minit
183

    
184
let pp_step machines fmt m : unit = 
185
  let out_assoc_list = 
186
    List.map (fun (node_inst, _) -> node_inst, "out_" ^ node_inst) m.minstances
187
  in
188
  fprintf fmt 
189
    "@[<v 2>public Output step (%a) {@,%a%t@,%a%a%t@,%a@,%t@]@,}@,"
190
    (Utils.fprintf_list ~sep:",@ " pp_var) m.mstep.step_inputs
191
    (* locals *)
192
    (Utils.fprintf_list ~sep:";@," pp_var) m.mstep.step_locals
193
    (pp_final_char_if_non_empty ";" m.mstep.step_locals) 
194
    (* declare out variables of subnode instances + out of this node *)
195
    (fprintf_list ~sep:"" 
196
       (fun fmt (ninst, ntype) -> fprintf fmt "%s.Output out_%s;@," (get_class_name ntype) ninst )) 
197
    (List.filter (fun (_,ntyp) -> not (ntyp = "_arrow")) m.minstances)
198
    (fprintf_list ~sep:";@," pp_var) m.mstep.step_outputs
199
    (pp_final_char_if_non_empty ";" m.mstep.step_outputs) 
200
    (* instructions *)
201
    (fprintf_list ~sep:"@," (pp_machine_instr m machines out_assoc_list)) m.mstep.step_instrs     
202
    (* create out object and return it *)
203
    (fun fmt -> fprintf fmt "return new Output(%a);" 
204
      (fprintf_list ~sep:"," (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_outputs 
205
    )
206
  
207

    
208

    
209
let print_machine machines fmt m =
210
  if m.mname.node_id = "_arrow" then () else ( (* We don't print arrow function *)
211
    fprintf fmt "@[<v 2>class %s {@,%a%t%a%t%t%a@,%a@,%a@,%a@]@,}@.@.@."
212
      (String.capitalize m.mname.node_id) (* class name *)
213
      (pp_local_fields "protected") m.mmemory                      (* fields *)
214
      (pp_newline_if_non_empty m.mmemory)            
215
      pp_local_field_instances m.minstances          (* object fields *)
216
      (pp_newline_if_non_empty m.minstances)         
217
      (pp_newline_if_non_empty m.minstances)         
218
      pp_output_class m.mstep                        (* class for output of step method *)
219
      pp_constructor (m.mname.node_id, m.minstances) (* constructor to instanciate object fields *)
220
      (pp_reset machines) m                               (* reset method *)
221
      (pp_step machines) m             (* step method *)
222

    
223
  )
224

    
225
(********************************************************************************************)
226
(*                         Main related functions                                           *)
227
(********************************************************************************************)
228

    
229
(* let print_get_input fmt v = *)
230
(*   match v.var_type.Types.tdesc with *)
231
(*     | Types.Tint -> fprintf fmt "_get_int(\"%s\")" v.var_id *)
232
(*     | Types.Tbool -> fprintf fmt "_get_bool(\"%s\")" v.var_id *)
233
(*     | Types.Treal -> fprintf fmt "_get_double(\"%s\")" v.var_id *)
234
(*     | _ -> assert false *)
235

    
236
(* let print_put_outputs fmt ol =  *)
237
(*   let po fmt o = *)
238
(*     match o.var_type.Types.tdesc with *)
239
(*     | Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o.var_id o.var_id *)
240
(*     | Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o.var_id o.var_id *)
241
(*     | Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o.var_id o.var_id *)
242
(*     | _ -> assert false *)
243
(*   in *)
244
(*   List.iter (fprintf fmt "@ %a;" po) ol *)
245

    
246
let read_input fmt typ = match typ.Types.tdesc with
247
  | Types.Treal -> fprintf fmt "StdIn.readDouble()"
248
  | Types.Tint ->  fprintf fmt "StdIn.readInt()"
249
  | Types.Tbool ->  fprintf fmt "StdIn.readBoolean()"
250
  | _ -> assert false
251

    
252
let print_main_fun basename machines m fmt =
253
  let m_class = String.capitalize m.mname.node_id in
254
  fprintf fmt "@[<v 2>class %s {@,@,@[<v 2>%s {@,%t@,%t@]@,}@,@]@,}@."
255
    (String.capitalize basename)
256
    "public static void main (String[] args)"
257
    (fun fmt -> fprintf fmt "%s main_node = new %s();"  m_class m_class)
258
    (fun fmt -> fprintf fmt "@[<v 2>while (true) {@,%a@,%t@,%a@]@,}@,"  
259
      (fprintf_list ~sep:"@," 
260
	 (fun fmt v -> fprintf fmt "System.out.println(\"%s?\");@,%a = %a;" 
261
	   v.var_id pp_var v read_input v.var_type))
262
      m.mstep.step_inputs
263
      (fun fmt -> fprintf fmt "%s.Output out = main_node.step(%a);" 
264
	m_class  
265
	(fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs
266
      )
267
      (fprintf_list ~sep:"@," (fun fmt v -> fprintf fmt "System.out.println(\"%s = \" + out.%s);" v.var_id v.var_id))
268
      m.mstep.step_outputs
269
    )
270
    
271
    
272
(* let print_main_fun machines m fmt = *)
273
(*   let mname = m.mname.node_id in *)
274
(*   let main_mem = *)
275
(*     if (!Options.static_mem && !Options.main_node <> "") *)
276
(*     then "&main_mem" *)
277
(*     else "main_mem" in *)
278
(*   fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; *)
279
(*   fprintf fmt "/* Declaration of inputs/outputs variables */@ "; *)
280
(*   List.iter  *)
281
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
282
(*     ) m.mstep.step_inputs; *)
283
(*   List.iter  *)
284
(*     (fun v -> fprintf fmt "%a %s = %a;@ " pp_c_type v.var_type v.var_id pp_c_initialize v.var_type *)
285
(*     ) m.mstep.step_outputs; *)
286
(*   fprintf fmt "@ /* Main memory allocation */@ "; *)
287
(*   if (!Options.static_mem && !Options.main_node <> "") *)
288
(*   then (fprintf fmt "%a(main_mem);@ " pp_machine_static_alloc_name mname) *)
289
(*   else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); *)
290
(*   fprintf fmt "@ /* Initialize the main memory */@ "; *)
291
(*   fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; *)
292
(*   fprintf fmt "@ ISATTY = isatty(0);@ "; *)
293
(*   fprintf fmt "@ /* Infinite loop */@ "; *)
294
(*   fprintf fmt "@[<v 2>while(1){@ "; *)
295
(*   fprintf fmt  "fflush(stdout);@ "; *)
296
(*   List.iter  *)
297
(*     (fun v -> fprintf fmt "%s = %a;@ " *)
298
(*       v.var_id *)
299
(*       print_get_input v *)
300
(*     ) m.mstep.step_inputs; *)
301
(*   (match m.mstep.step_outputs with *)
302
(*     | [] -> ( *)
303
(*       fprintf fmt "%a(%a%t%s);@ "  *)
304
(* 	pp_machine_step_name mname *)
305
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
306
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
307
(* 	main_mem *)
308
(*     ) *)
309
(*     | [o] -> ( *)
310
(*       fprintf fmt "%s = %a(%a%t%a, %s);%a" *)
311
(* 	o.var_id *)
312
(* 	pp_machine_step_name mname *)
313
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
314
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
315
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
316
(* 	main_mem *)
317
(* 	print_put_outputs [o]) *)
318
(*     | _ -> ( *)
319
(*       fprintf fmt "%a(%a%t%a, %s);%a" *)
320
(* 	pp_machine_step_name mname *)
321
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> pp_print_string fmt v.var_id)) m.mstep.step_inputs *)
322
(* 	(pp_final_char_if_non_empty ", " m.mstep.step_inputs) *)
323
(* 	(Utils.fprintf_list ~sep:", " (fun fmt v -> fprintf fmt "&%s" v.var_id)) m.mstep.step_outputs *)
324
(* 	main_mem *)
325
(* 	print_put_outputs m.mstep.step_outputs) *)
326
(*   ); *)
327
(*   fprintf fmt "@]@ }@ "; *)
328
(*   fprintf fmt "return 1;"; *)
329
(*   fprintf fmt "@]@ }@."        *)
330

    
331
(* let print_main_header fmt = *)
332
(*   fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"io_frontend.h\"@." *)
333
  
334
      
335
(********************************************************************************************)
336
(*                         Translation function                                             *)
337
(********************************************************************************************)
338

    
339
let translate_to_java source_fmt basename prog machines =
340

    
341
  
342
  (* If a main node is identified, generate a main function for it *)
343
  let main_print =
344
    match !Options.main_node with
345
      | "" -> (fun _ -> ())
346
      | main_node -> (
347
  	let main_node_opt =
348
  	  List.fold_left
349
  	    (fun res m ->
350
  	      match res with
351
  		| Some _ -> res
352
  		| None -> if m.mname.node_id = main_node then Some m else None)
353
  	    None machines
354
	in
355
	match main_node_opt with
356
  	  | None -> eprintf "Unable to find a main node named %s@.@?" main_node; (fun _ -> ())
357
  	  | Some m -> print_main_fun basename machines m
358
      )
359
  in
360
  
361
  (* Print nodes one by one (in the previous order) *)
362
  List.iter ((print_machine machines) source_fmt) machines;
363
  main_print source_fmt 
364

    
365

    
366

    
367

    
368
(* Local Variables: *)
369
(* compile-command:"make -C .." *)
370
(* End: *)