Project

General

Profile

Revision cefc3744

View differences:

src/backends/C/c_backend.ml
28 28
(*                         Translation function                                             *)
29 29
(********************************************************************************************)
30 30

  
31

  
31 32
let translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt 
32 33
                   basename prog machines dependencies =
33 34

  
35

  
36
  let module HeaderMod = C_backend_header.EmptyMod in
37
  let module Header = C_backend_header.Main (HeaderMod) in
38

  
39
  let module SourceMod = C_backend_src.EmptyMod in
40
  let module Source = C_backend_src.Main (SourceMod) in
41

  
42
  let module MakefileMod = C_backend_makefile.EmptyMod in
43
  let module Makefile = C_backend_makefile.Main (MakefileMod) in
44

  
45

  
34 46
  (* Generating H file *)
35
  C_backend_header.print_header header_fmt basename prog machines;
47
  Header.print_header header_fmt basename prog machines;
36 48

  
37 49
  (* Generating C file *)
38
  C_backend_src.print_c source_fmt basename prog machines dependencies;
50
  Source.print_c source_fmt basename prog machines dependencies;
39 51

  
40 52
  (* Generating Makefile *)
41 53
  (* If a main node is identified, generate a main target for it *)
......
45 57
	match Machine_code.get_machine_opt main_node machines with
46 58
	| None -> Format.eprintf "Unable to find a main node named %s@.@?" main_node; 
47 59
	  ()
48
	| Some _ -> C_backend_makefile.print_makefile basename !Options.main_node dependencies makefile_fmt
60
	| Some _ -> Makefile.print_makefile basename !Options.main_node dependencies makefile_fmt
49 61
      )
50 62

  
51 63
(* Local Variables: *)
src/backends/C/c_backend_common.ml
213 213
    | Fun (n, vl)   -> Basic_library.pp_c n (pp_c_val self pp_var) fmt vl
214 214

  
215 215
let pp_c_checks self fmt m =
216
  Utils.fprintf_list ~sep:"" (fun fmt (loc, check) -> fprintf fmt "@[<v>%a@,assert (%a);@]@," Location.pp_c_loc loc (pp_c_val self (pp_c_var_read m)) check) fmt m.mstep.step_checks
216
  Utils.fprintf_list ~sep:"" 
217
    (fun fmt (loc, check) -> 
218
      fprintf fmt 
219
	"@[<v>%a@,assert (%a);@]@," 
220
	Location.pp_c_loc loc
221
	(pp_c_val self (pp_c_var_read m)) check
222
    ) 
223
    fmt 
224
    m.mstep.step_checks
217 225

  
218 226

  
219 227
(********************************************************************************************)
src/backends/C/c_backend_header.ml
7 7
(********************************************************************************************)
8 8
(*                         Header Printing functions                                        *)
9 9
(********************************************************************************************)
10
let print_machine_decl_prefix = ref (fun fmt x -> ())
11 10

  
12 11

  
12
module type MODIFIERS_HDR =
13
sig
14
  val print_machine_decl_prefix: Format.formatter -> Machine_code.machine_t -> unit
15
end
16

  
17
module EmptyMod =
18
struct
19
  let print_machine_decl_prefix = fun fmt x -> ()
20
end
21

  
22
module Main = functor (Mod: MODIFIERS_HDR) -> 
23
struct
24

  
13 25
let print_import_standard fmt =
14 26
  fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
15 27

  
......
107 119

  
108 120
 
109 121
let print_machine_decl fmt m =
110
  !print_machine_decl_prefix fmt m;
122
  Mod.print_machine_decl_prefix fmt m;
111 123
  if fst (get_stateless_status m) then
112 124
    begin
113 125
      fprintf fmt "extern %a;@.@."
......
182 194
(********************************************************************************************)
183 195
(*                         MAIN Header Printing functions                                   *)
184 196
(********************************************************************************************)
185

  
186 197
let print_header header_fmt basename prog machines =
187 198
  (* Include once: start *)
188 199
  let baseNAME = String.uppercase basename in
......
214 225
  (* Include once: end *)
215 226
  fprintf header_fmt "#endif@.";
216 227
  pp_print_newline header_fmt ()
228
end
217 229

  
218 230
(* Local Variables: *)
219 231
(* compile-command:"make -C ../../.." *)
src/backends/C/c_backend_makefile.ml
1 1
open Format
2 2
open Corelang
3 3

  
4
module type MODIFIERS_MKF =
5
sig
6
end
7

  
8
module EmptyMod =
9
struct
10
end
11

  
12
module Main = functor (Mod: MODIFIERS_MKF) -> 
13
struct
14

  
4 15
let header_has_code header =
5 16
  List.exists 
6 17
    (fun top -> 
......
50 61
 fprintf fmt "@.";
51 62
 fprintf fmt "clean:@.";
52 63
 fprintf fmt "\t\\rm -f *.o %s_%s@." basename nodename
53

  
64
end
54 65

  
55 66
(* Local Variables: *)
56 67
(* compile-command:"make -C ../../.." *)
src/backends/C/c_backend_spec.ml
3 3

  
4 4
(**************************************************************************)
5 5

  
6
let pp_acsl_type var fmt t =
7
  let rec aux t pp_suffix =
8
  match (Types.repr t).Types.tdesc with
9
  | Types.Tclock t'       -> aux t' pp_suffix
10
  | Types.Tbool           -> fprintf fmt "int %s%a" var pp_suffix ()
11
  | Types.Treal           -> fprintf fmt "real %s%a" var pp_suffix ()
12
  | Types.Tint            -> fprintf fmt "int %s%a" var pp_suffix ()
13
  | Types.Tarray (d, t')  ->
14
    let pp_suffix' fmt () = fprintf fmt "%a[%a]" pp_suffix () pp_c_dimension d in
15
    aux t' pp_suffix'
16
  (* | Types.Tstatic (_, t') -> fprintf fmt "const "; aux t' pp_suffix *)
17
  (* | Types.Tconst ty       -> fprintf fmt "%s %s" ty var *)
18
  (* | Types.Tarrow (_, _)   -> fprintf fmt "void (\*%s)()" var *)
19
  | _                     -> eprintf "internal error: pp_acsl_type %a@." Types.print_ty t; assert false
20
  in aux t (fun fmt () -> ())
21

  
22
let pp_acsl_var_decl fmt id =
23
  pp_acsl_type id.var_id fmt id.var_type
24

  
6 25

  
7 26
let pp_econst fmt c = 
8 27
  match c with
src/backends/C/c_backend_src.ml
4 4
open Machine_code
5 5
open C_backend_common
6 6

  
7
module type MODIFIERS_SRC =
8
sig
9
end
10

  
11
module EmptyMod =
12
struct
13
end
14

  
15
module Main = functor (Mod: MODIFIERS_SRC) -> 
16
struct
17

  
7 18
(********************************************************************************************)
8 19
(*                    Instruction Printing functions                                        *)
9 20
(********************************************************************************************)
......
370 381
  (* Print nodes one by one (in the previous order) *)
371 382
  List.iter (print_machine dependencies source_fmt) machines;
372 383
  main_print source_fmt
373

  
384
end
374 385

  
375 386
(* Local Variables: *)
376 387
(* compile-command:"make -C ../../.." *)

Also available in: Unified diff