Project

General

Profile

« Previous | Next » 

Revision f0a067e9

Added by Pierre-Loïc Garoche almost 3 years ago

Better production of trace files.
By default traces are not produced. Requires the option -t to produce them

View differences:

src/backends/C/c_backend_common.ml
705 705

  
706 706
  (*** Common functions for main ***)
707 707

  
708
let pp_print_file file_suffix fmt typ arg =
709
  fprintf fmt "@[<v 2>if (traces) {@ ";
710
  fprintf fmt "fprintf(f_%s, \"%%%s\\n\", %s);@ " file_suffix typ arg;
711
  fprintf fmt "fflush(f_%s);@ " file_suffix;
712
  fprintf fmt "@]}@ "
713
  
708 714
let print_put_var fmt file_suffix name var_type var_id =
715
  let pp_file = pp_print_file ("out" ^ file_suffix) in
709 716
  let unclocked_t = Types.unclock_type var_type in
710
  if Types.is_int_type unclocked_t then
711
    fprintf fmt "_put_int(f_out%s, \"%s\", %s)" file_suffix name var_id
712
  else if Types.is_bool_type unclocked_t then
713
    fprintf fmt "_put_bool(f_out%s, \"%s\", %s)" file_suffix name var_id
717
  if Types.is_int_type unclocked_t then (
718
    fprintf fmt "_put_int(\"%s\", %s);@ " name var_id;
719
    pp_file fmt "d" var_id
720
  )
721
  else if Types.is_bool_type unclocked_t then (
722
    fprintf fmt "_put_bool(\"%s\", %s);@ " name var_id;
723
    pp_file fmt "i" var_id
724
  )
714 725
  else if Types.is_real_type unclocked_t then
715
    if !Options.mpfr then
716
      fprintf fmt "_put_double(f_out%s, \"%s\", mpfr_get_d(%s, %s), %i)" file_suffix name var_id (Mpfr.mpfr_rnd ()) !Options.print_prec_double
717
    else
718
      fprintf fmt "_put_double(f_out%s, \"%s\", %s, %i)" file_suffix name var_id !Options.print_prec_double
726
    let _ =
727
      if !Options.mpfr then
728
        fprintf fmt "_put_double(\"%s\", mpfr_get_d(%s, %s), %i);@ " name var_id (Mpfr.mpfr_rnd ()) !Options.print_prec_double
729
      else
730
        fprintf fmt "_put_double(\"%s\", %s, %i);@ " name var_id !Options.print_prec_double
731
    in
732
    pp_file fmt ".*f" ((string_of_int !Options.print_prec_double) ^ ", " ^ var_id)
719 733
  else
720 734
    (Format.eprintf "Impossible to print the _put_xx for type %a@.@?" Types.print_ty var_type; assert false)
721 735

  
722 736
      
723 737
let print_get_inputs fmt m =
724 738
  let pi fmt (id, v', v) =
725

  
739
    let pp_file = pp_print_file ("in" ^ (string_of_int id)) in
726 740
    let unclocked_t = Types.unclock_type v.var_type in
727
    if Types.is_int_type unclocked_t then
728
      fprintf fmt "%s = _get_int(f_in%i, \"%s\")" v.var_id id v'.var_id
729
    else if Types.is_bool_type unclocked_t then
730
      fprintf fmt "%s = _get_bool(f_in%i, \"%s\")" v.var_id id v'.var_id
741
    if Types.is_int_type unclocked_t then (
742
      fprintf fmt "%s = _get_int(\"%s\");@ " v.var_id v'.var_id;
743
      pp_file fmt "d" v.var_id
744
    )
745
    else if Types.is_bool_type unclocked_t then (
746
      fprintf fmt "%s = _get_bool(\"%s\");@ " v.var_id v'.var_id;
747
      pp_file fmt "i" v.var_id
748
    )
731 749
    else if Types.is_real_type unclocked_t then
732
      if !Options.mpfr then
733
	fprintf fmt "mpfr_set_d(%s, _get_double(f_in%i, \"%s\"), %i)" v.var_id id v'.var_id (Mpfr.mpfr_prec ())
734
      else
735
	fprintf fmt "%s = _get_double(f_in%i, \"%s\")" v.var_id id v'.var_id
750
        if !Options.mpfr then (
751
	  fprintf fmt "double %s_tmp = _get_double(\"%s\");@ " v.var_id v'.var_id;
752
          pp_file fmt "f" (v.var_id ^ "_tmp");
753
          fprintf fmt "mpfr_set_d(%s, %s_tmp, %i);" v.var_id v.var_id (Mpfr.mpfr_prec ())
754
        )
755
        else (
756
	  fprintf fmt "%s = _get_double(\"%s\");@ " v.var_id v'.var_id;
757
          pp_file fmt "f" v.var_id
758
        )
736 759
    else
737 760
      begin
738 761
	Global.main_node := !Options.main_node;
......
743 766
      end
744 767
  in
745 768
  Utils.List.iteri2 (fun idx v' v ->
746
    fprintf fmt "@ %a;" pi ((idx+1), v', v);
769
    fprintf fmt "@ %a" pi ((idx+1), v', v);
747 770
  ) m.mname.node_inputs m.mstep.step_inputs
748 771

  
749 772

  
773
let pp_file_decl fmt inout idx =
774
  let idx = idx + 1 in (* we start from 1: in1, in2, ... *)
775
  fprintf fmt "FILE *f_%s%i;@ " inout idx 
776

  
777
let pp_file_open fmt inout idx =
778
  let idx = idx + 1 in (* we start from 1: in1, in2, ... *)
779
  fprintf fmt "const char* cst_char_suffix_%s%i = \"_simu.%s%i\";@ " inout idx inout idx;
780
  fprintf fmt "size_t l%s%i = strlen(dir) + strlen(prefix) + strlen(cst_char_suffix_%s%i);@ " inout idx inout idx;
781
  fprintf fmt "char* f_%s%i_name = malloc((l%s%i+2) * sizeof(char));@ " inout idx inout idx;
782
  fprintf fmt "strcpy (f_%s%i_name, dir);@ " inout idx;
783
  fprintf fmt "strcat(f_%s%i_name, \"/\");@ " inout idx;
784
  fprintf fmt "strcat(f_%s%i_name, prefix);@ " inout idx;
785
  fprintf fmt "strcat(f_%s%i_name, cst_char_suffix_%s%i);@ " inout idx inout idx;
786
  fprintf fmt "f_%s%i = fopen(f_%s%i_name, \"w\");@ " inout idx inout idx;
787
  fprintf fmt "free(f_%s%i_name);@ " inout idx;
788
  "f_" ^ inout ^ (string_of_int idx)
789

  
790

  
750 791
(* Local Variables: *)
751 792
(* compile-command:"make -C ../../.." *)
752 793
(* End: *)

Also available in: Unified diff