Project

General

Profile

Revision 8d164031

View differences:

include/mpfr_lustre.c
101 101
{
102 102
  mpfr_set_si(out, i, MPFR_RNDN);
103 103
}
104

  
105
void MPFRreal_to_int_step (mpfr_t in1, int *out)
106
{
107
  *out = mpfr_get_sj (in1, MPFR_RNDN); 
108
}
109

  
110
void MPFRFloor (mpfr_t in1, int *out)
111
{
112
  mpfr_t tmp;
113
  int prec;
114
  mpfr_init (tmp); // would be better to avoid local init  
115
  prec = mpfr_get_prec (in1);
116
  mpfr_set_prec(tmp, prec);
117

  
118
  mpfr_floor(tmp, in1);
119
  *out = mpfr_get_sj (tmp, MPFR_RNDN);
120

  
121
  mpfr_clear(tmp);
122
}
123

  
124
void MPFRCeiling (mpfr_t in1, int *out)
125
{
126
  mpfr_t tmp;
127
  int prec;
128
  mpfr_init (tmp); // would be better to avoid local init  
129
  prec = mpfr_get_prec (in1);
130
  mpfr_set_prec(tmp, prec);
131
  
132
  mpfr_ceil(tmp, in1);
133
  *out = mpfr_get_sj (tmp, MPFR_RNDN);
134

  
135
  mpfr_clear(tmp);
136
}
137

  
138
void MPFRRound (mpfr_t in1, int *out)
139
{
140
  mpfr_t tmp;
141
  int prec;
142
  mpfr_init (tmp); // would be better to avoid local init  
143
  prec = mpfr_get_prec (in1);
144
  mpfr_set_prec(tmp, prec);
145
  
146
  mpfr_round(tmp, in1);
147
  *out = mpfr_get_sj (tmp, MPFR_RNDN);
148

  
149
  mpfr_clear(tmp);
150
}
151

  
104 152
// functions of lustrec_math
105 153
void MPFRacos_step (mpfr_t i, 
106 154
                             mpfr_t out
include/mpfr_lustre.lusi
22 22

  
23 23
-- Functions already available in conv
24 24
function MPFRint_to_real (x: int) returns (y: real);
25
function MPFRreal_to_int (in1: real) returns (out: int);
26
function MPFRFloor (in1: real) returns (out: int);
27
function MPFRCeiling (in1: real) returns (out: int);
28
function MPFRRound (in1: real) returns (out: int);
25 29

  
26 30
-- Functions already available in lustrec_math
27 31

  
src/backends/C/c_backend_common.ml
723 723
    pp_file fmt "i" var_id
724 724
  )
725 725
  else if Types.is_real_type unclocked_t then
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)
726
    
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
        pp_file fmt ".*f" ((string_of_int !Options.print_prec_double) ^ ", mpfr_get_d(" ^ var_id ^ ", MPFR_RNDN)")
730
      )
731
      else (
732
        fprintf fmt "_put_double(\"%s\", %s, %i);@ " name var_id !Options.print_prec_double;
733
        pp_file fmt ".*f" ((string_of_int !Options.print_prec_double) ^ ", " ^ var_id)
734
      )
735
    
733 736
  else
734 737
    (Format.eprintf "Impossible to print the _put_xx for type %a@.@?" Types.print_ty var_type; assert false)
735 738

  
src/plugins/mpfr/mpfr.ml
16 16
open Normalization
17 17
open Machine_code_common
18 18

  
19
let report = Log.report ~plugin:"MPFR"
20
           
19 21
let mpfr_module = mktop (Open(false, "mpfr_lustre"))
20 22
let cpt_fresh = ref 0
21 23
  
......
99 101
  | "!="     -> "MPFRNeq"
100 102
  (* Conv functions *)
101 103
  | "int_to_real" -> "MPFRint_to_real"
104
  | "real_to_int" -> "MPFRreal_to_int"
105
  | "_floor" -> "MPFRfloor"        
106
  | "_ceil" -> "MPFRceil"        
107
  | "_round" -> "MPFRround"        
108
  | "_Floor" -> "MPFRFloor"        
109
  | "_Ceiling" -> "MPFRCeiling"        
110
  | "_Round" -> "MPFRRound"        
111
       
102 112
  (* Math library functions *)
103 113
  | "acos" -> "MPFRacos"
104 114
  | "acosh" -> "MPFRacosh"
......
128 138
  | _        -> raise Not_found
129 139

  
130 140
let inject_op id =
131
  Format.eprintf "trying to inject mpfr into function %s@." id;
141
  report ~level:3 (fun fmt -> Format.fprintf fmt "trying to inject mpfr into function %s@." id);
132 142
  try
133 143
    base_inject_op id
134 144
  with Not_found -> id

Also available in: Unified diff