Project

General

Profile

Revision 6fa45cb6

View differences:

include/io_frontend.c
6 6
int ISATTY;
7 7

  
8 8
/* Standard Input procedures **************/
9
_Bool _get_bool(char* n){
9
_Bool _get_bool(FILE* file, char* n){
10 10
   char b[512];
11 11
   _Bool r = 0;
12 12
   int s = 1;
......
22 22
      if((c == '0') || (c == 'f') || (c == 'F')) r = 0;
23 23
      if((c == '1') || (c == 't') || (c == 'T')) r = 1;
24 24
   } while((s != 1) || (r == -1));
25
   fprintf(file, "%i\n",r);
25 26
   return r;
26 27
}
27
int _get_int(char* n){
28

  
29
int _get_int(FILE* file, char* n){
28 30
   char b[512];
29 31
   int r;
30 32
   int s = 1;
......
36 38
      if(scanf("%s", b)==EOF) exit(0);
37 39
      s = sscanf(b, "%d", &r);
38 40
   } while(s != 1);
41
   fprintf(file, "%d\n", r);
39 42
   return r;
40 43
}
41
double _get_double(char* n){
44

  
45
double _get_double(FILE* file, char* n){
42 46
   char b[512];
43 47
   double r;
44 48
   int s = 1;
......
50 54
      if(scanf("%s", b)==EOF) exit(0);
51 55
      s = sscanf(b, "%lf", &r);
52 56
   } while(s != 1);
57
   fprintf(file, "%f\n", r);
53 58
   return r;
54 59
}
55 60
/* Standard Output procedures **************/
56
void _put_bool(char* n, _Bool _V){
61
void _put_bool(FILE* file, char* n, _Bool _V){
57 62
  if(ISATTY) {
58 63
    printf("%s = ", n);
59 64
  } else {
......
61 66
  };
62 67
  printf("'%i' ", (_V)? 1 : 0);
63 68
  printf("\n");
69
  fprintf(file, "%i\n", _V);
64 70
}
65
void _put_int(char* n, int _V){
71
void _put_int(FILE* file, char* n, int _V){
66 72
  if(ISATTY) {
67 73
    printf("%s = ", n);
68 74
  } else {
......
70 76
  };
71 77
  printf("'%d' ", _V);
72 78
  printf("\n");
79
  fprintf(file, "%d\n", _V);
73 80
}
74
void _put_double(char* n, double _V){
81
void _put_double(FILE* file, char* n, double _V){
75 82
  if(ISATTY) {
76 83
    printf("%s = ", n);
77 84
  } else {
......
79 86
  };
80 87
  printf("'%f' ", _V);
81 88
  printf("\n");
89
  fprintf(file, "%f\n", _V);
82 90
}
include/io_frontend.h
7 7
/* Standard Input procedures **************/
8 8

  
9 9
/*@ assigns *n; */
10
extern _Bool _get_bool(char* n);
10
extern _Bool _get_bool(FILE* file, char* n);
11 11

  
12 12
/*@ assigns *n; */
13
extern int _get_int(char* n);
13
extern int _get_int(FILE* file, char* n);
14 14

  
15 15
/*@ assigns *n; */
16
extern double _get_double(char* n);
16
extern double _get_double(FILE* file, char* n);
17 17

  
18 18
/* Standard Output procedures **************/
19 19
/*@ assigns \nothing; */
20
extern void _put_bool(char* n, _Bool _V);
20
extern void _put_bool(FILE* file, char* n, _Bool _V);
21 21

  
22 22
/*@ assigns \nothing; */
23
extern void _put_int(char* n, int _V);
23
extern void _put_int(FILE* file, char* n, int _V);
24 24

  
25 25
/*@ assigns \nothing; */
26
extern void _put_double(char* n, double _V);
26
extern void _put_double(FILE* file, char* n, double _V);
27 27

  
28 28
#endif
src/backends/C/c_backend_main.ml
14 14
open Machine_code
15 15
open Format
16 16
open C_backend_common
17
open Utils
17 18

  
18 19
module type MODIFIERS_MAINSRC =
19 20
sig
......
31 32
(********************************************************************************************)
32 33

  
33 34
let print_get_inputs fmt m =
34
  let pi fmt (v', v) =
35
  let pi fmt (id, v', v) =
35 36
  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
37
    | Types.Tint -> fprintf fmt "%s = _get_int(f_in%i, \"%s\")" v.var_id id v'.var_id
38
    | Types.Tbool -> fprintf fmt "%s = _get_bool(f_in%i, \"%s\")" v.var_id id v'.var_id
39
    | Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(f_in%i, \"%s\"), %i)" v.var_id id v'.var_id (Mpfr.mpfr_prec ())
40
    | Types.Treal -> fprintf fmt "%s = _get_double(f_in%i, \"%s\")" v.var_id id v'.var_id
40 41
    | _ ->
41 42
      begin
42 43
	Global.main_node := !Options.main_node;
......
46 47
	raise (Error (v'.var_loc, Main_wrong_kind))
47 48
      end
48 49
  in
49
  List.iter2 (fun v' v -> fprintf fmt "@ %a;" pi (v', v)) m.mname.node_inputs m.mstep.step_inputs
50
  List.iteri2 (fun idx v' v ->
51
    fprintf fmt "@ %a;" pi ((idx+1), v', v);
52
  ) m.mname.node_inputs m.mstep.step_inputs
50 53

  
51 54
let print_put_outputs fmt m = 
52
  let po fmt (o', o) =
55
  let po fmt (id, o', o) =
53 56
    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
57
    | Types.Tint -> fprintf fmt "_put_int(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
58
    | Types.Tbool -> fprintf fmt "_put_bool(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
59
    | Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(f_out%i, \"%s\", mpfr_get_d(%s, %s))" id o'.var_id o.var_id (Mpfr.mpfr_rnd ())
60
    | Types.Treal -> fprintf fmt "_put_double(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
58 61
    | _ -> assert false
59 62
  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
63
  Utils.List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs
72 64

  
65
let print_main_inout_declaration basename fmt m =
66
  let mname = m.mname.node_id in
67
  fprintf fmt "/* Declaration of inputs/outputs variables */@ ";
68
  List.iteri 
69
    (fun idx v ->
70
      fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
71
      fprintf fmt "FILE *f_in%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
72
      fprintf fmt "f_in%i = fopen(\"%s_%s_simu.in%i\", \"w\");@ " (idx+1) basename mname (idx+1);
73
    ) m.mstep.step_inputs;
74
  List.iteri 
75
    (fun idx v ->
76
      fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
77
      fprintf fmt "FILE *f_out%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
78
      fprintf fmt "f_out%i = fopen(\"%s_%s_simu.out%i\", \"w\");@ " (idx+1) basename mname (idx+1);
79
    ) m.mstep.step_outputs
80

  
81

  
82
  
73 83
let print_main_memory_allocation mname main_mem fmt m =
74 84
  if not (fst (get_stateless_status m)) then
75 85
  begin  
......
132 142
    fprintf fmt "@ /* Infinite loop */@ ";
133 143
    fprintf fmt "@[<v 2>while(1){@ ";
134 144
    fprintf fmt  "fflush(stdout);@ ";
145
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_in%i);@ " (idx+1)) m.mstep.step_inputs;
146
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_out%i);@ " (idx+1)) m.mstep.step_outputs;
135 147
    fprintf fmt "%a@ %t%a"
136 148
      print_get_inputs m
137 149
      (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
......
145 157
    then "&main_mem"
146 158
    else "main_mem" in
147 159
  fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
148
  print_main_inout_declaration fmt m;
160
  print_main_inout_declaration basename fmt m;
149 161
  print_main_memory_allocation mname main_mem fmt m;
150 162
  if !Options.mpfr then
151 163
    begin
src/utils.ml
361 361
let new_tag () =
362 362
  incr last_tag; !last_tag
363 363

  
364

  
365
module List =
366
struct
367
  include List 
368
  let iteri2 f l1 l2 =
369
    if List.length l1 <> List.length l2 then
370
      raise (Invalid_argument "iteri2: lists have different lengths")
371
    else
372
      let rec run idx l1 l2 =
373
	match l1, l2 with
374
	| [], [] -> ()
375
	| hd1::tl1, hd2::tl2 -> (
376
	  f idx hd1 hd2;
377
	  run (idx+1) tl1 tl2
378
	)
379
	| _ -> assert false
380
      in
381
      run 0 l1 l2
382
end
383

  
384
  
364 385
(* Local Variables: *)
365 386
(* compile-command:"make -C .." *)
366 387
(* End: *)

Also available in: Unified diff