diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/grt/grt-images.adb | 85 | ||||
| -rw-r--r-- | translate/grt/grt-vstrings.adb | 87 | ||||
| -rw-r--r-- | translate/grt/grt-vstrings.ads | 5 |
3 files changed, 94 insertions, 83 deletions
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index 25d7fcc..7d98940 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -143,91 +143,10 @@ package body Grt.Images is procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64) is - function Trunc (V : Ghdl_F64) return Ghdl_F64; - pragma Import (C, Trunc); - - -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) - -- + exp_digits (4) -> 24. - Str : String (1 .. 25); + Str : String (1 .. 24); P : Natural; - V : Ghdl_F64; - Vmax : Ghdl_F64; - Vd : Ghdl_F64; - Exp : Integer; - D : Integer; - B : Boolean; begin - -- Handle sign. - if Val < 0.0 then - Str (1) := '-'; - P := 1; - V := -Val; - else - P := 0; - V := Val; - end if; - - -- Compute the mantissa. - -- and normalize V in [0 .. 10.0[ - -- FIXME: should do a dichotomy. - if V = 0.0 then - Exp := 0; - elsif V < 1.0 then - Exp := 0; - loop - exit when V >= 1.0; - Exp := Exp - 1; - V := V * 10.0; - end loop; - else - Exp := 0; - loop - exit when V < 10.0; - Exp := Exp + 1; - V := V / 10.0; - end loop; - end if; - - Vmax := 10.0 ** (1 - 15); - for I in 0 .. 15 loop - -- Vd := Ghdl_F64'Truncation (V); - Vd := Trunc (V); - P := P + 1; - Str (P) := Character'Val (48 + Integer (Vd)); - V := (V - Vd) * 10.0; - - if I = 0 then - P := P + 1; - Str (P) := '.'; - end if; - exit when I > 0 and V < Vmax; - Vmax := Vmax * 10.0; - end loop; - - if Exp /= 0 then - -- LRM93 14.3 - -- if the exponent is present, the `e' is written as a lower case - -- character. - P := P + 1; - Str (P) := 'e'; - - if Exp < 0 then - P := P + 1; - Str (P) := '-'; - Exp := -Exp; - end if; - B := False; - for I in 0 .. 4 loop - D := (Exp / 10000) mod 10; - if D /= 0 or B or I = 4 then - P := P + 1; - Str (P) := Character'Val (48 + D); - B := True; - end if; - Exp := (Exp - D * 10000) * 10; - end loop; - end if; - + To_String (Str, P, Val); Return_String (Res, Str (1 .. P)); end Ghdl_Image_F64; diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb index 35a8032..005bc89 100644 --- a/translate/grt/grt-vstrings.adb +++ b/translate/grt/grt-vstrings.adb @@ -251,4 +251,91 @@ package body Grt.Vstrings is procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64) renames To_String_I64; + + procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64) + is + function Trunc (V : Ghdl_F64) return Ghdl_F64; + pragma Import (C, Trunc); + + P : Natural := Str'First; + V : Ghdl_F64; + Vmax : Ghdl_F64; + Vd : Ghdl_F64; + Exp : Integer; + D : Integer; + B : Boolean; + begin + -- Handle sign. + if N < 0.0 then + Str (P) := '-'; + P := P + 1; + V := -N; + else + V := N; + end if; + + -- Compute the mantissa. + -- and normalize V in [0 .. 10.0[ + -- FIXME: should do a dichotomy. + if V = 0.0 then + Exp := 0; + elsif V < 1.0 then + Exp := 0; + loop + exit when V >= 1.0; + Exp := Exp - 1; + V := V * 10.0; + end loop; + else + Exp := 0; + loop + exit when V < 10.0; + Exp := Exp + 1; + V := V / 10.0; + end loop; + end if; + + Vmax := 10.0 ** (1 - 15); + for I in 0 .. 15 loop + -- Vd := Ghdl_F64'Truncation (V); + Vd := Trunc (V); + Str (P) := Character'Val (48 + Integer (Vd)); + P := P + 1; + V := (V - Vd) * 10.0; + + if I = 0 then + Str (P) := '.'; + P := P + 1; + end if; + exit when I > 0 and V < Vmax; + Vmax := Vmax * 10.0; + end loop; + + if Exp /= 0 then + -- LRM93 14.3 + -- if the exponent is present, the `e' is written as a lower case + -- character. + Str (P) := 'e'; + P := P + 1; + + if Exp < 0 then + Str (P) := '-'; + P := P + 1; + Exp := -Exp; + end if; + B := False; + for I in 0 .. 4 loop + D := (Exp / 10000) mod 10; + if D /= 0 or B or I = 4 then + Str (P) := Character'Val (48 + D); + P := P + 1; + B := True; + end if; + Exp := (Exp - D * 10000) * 10; + end loop; + end if; + + Last := P - 1; + end To_String; + end Grt.Vstrings; diff --git a/translate/grt/grt-vstrings.ads b/translate/grt/grt-vstrings.ads index d10bf44..0f5938e 100644 --- a/translate/grt/grt-vstrings.ads +++ b/translate/grt/grt-vstrings.ads @@ -84,6 +84,11 @@ package Grt.Vstrings is -- Requires at least 21 characters. procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64); + -- Requires at least 24 characters. + -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) + -- + exp_digits (4) -> 24. + procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64); + private subtype Fat_String is String (Positive); type Fat_String_Acc is access Fat_String; |