aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-cbinding.c13
-rw-r--r--translate/grt/grt-files.adb23
-rw-r--r--translate/grt/grt-files.ads4
-rw-r--r--translate/grt/grt-vstrings.adb81
-rw-r--r--translate/grt/grt-vstrings.ads33
5 files changed, 149 insertions, 5 deletions
diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
index a913a4453..4da06c594 100644
--- a/translate/grt/grt-cbinding.c
+++ b/translate/grt/grt-cbinding.c
@@ -46,6 +46,19 @@ __ghdl_snprintf_g (char *buf, unsigned int len, double val)
}
void
+__ghdl_snprintf_nf (char *buf, unsigned int len, int ndigits, double val)
+{
+ snprintf (buf, len, "%.*f", ndigits, val);
+}
+
+void
+__ghdl_snprintf_fmtf (const char *buf, unsigned int len,
+ const char *format, double v)
+{
+ snprintf (buf, len, format, v);
+}
+
+void
__ghdl_fprintf_g (FILE *stream, double val)
{
fprintf (stream, "%g", val);
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index 1688a269b..30d51cf43 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -32,6 +32,8 @@ pragma Elaborate_All (Grt.Table);
package body Grt.Files is
subtype C_Files is Grt.Stdio.FILEs;
+ Auto_Flush : constant Boolean := False;
+
type File_Entry_Type is record
Stream : C_Files;
Signature : Ghdl_C_String;
@@ -307,7 +309,9 @@ package body Grt.Files is
-- FIXME: check r
-- Write '\n'.
R1 := fputc (Character'Pos (Nl), Res);
- R1 := fflush (Res);
+ if Auto_Flush then
+ fflush (Res);
+ end if;
end Ghdl_Text_Write;
procedure Ghdl_Write_Scalar (File : Ghdl_File_Index;
@@ -316,8 +320,6 @@ package body Grt.Files is
is
Res : C_Files;
R : size_t;
- R1 : int;
- pragma Unreferenced (R1);
begin
Res := Get_File (File);
Check_File_Mode (File, False);
@@ -329,7 +331,9 @@ package body Grt.Files is
if R /= 1 then
Error ("write_scalar failed");
end if;
- R1 := fflush (Res);
+ if Auto_Flush then
+ fflush (Res);
+ end if;
end Ghdl_Write_Scalar;
procedure Ghdl_Read_Scalar (File : Ghdl_File_Index;
@@ -433,5 +437,16 @@ package body Grt.Files is
begin
File_Close (File, False);
end Ghdl_File_Close;
+
+ procedure Ghdl_File_Flush (File : Ghdl_File_Index)
+ is
+ Stream : C_Files;
+ begin
+ Stream := Get_File (File);
+ if Stream = NULL_Stream then
+ return;
+ end if;
+ fflush (Stream);
+ end Ghdl_File_Flush;
end Grt.Files;
diff --git a/translate/grt/grt-files.ads b/translate/grt/grt-files.ads
index 2d4b10567..14f998468 100644
--- a/translate/grt/grt-files.ads
+++ b/translate/grt/grt-files.ads
@@ -89,6 +89,8 @@ package Grt.Files is
procedure Ghdl_Text_File_Close (File : Ghdl_File_Index);
procedure Ghdl_File_Close (File : Ghdl_File_Index);
+
+ procedure Ghdl_File_Flush (File : Ghdl_File_Index);
private
pragma Export (Ada, Ghdl_File_Endfile, "__ghdl_file_endfile");
@@ -116,4 +118,6 @@ private
pragma Export (C, Ghdl_Text_File_Close, "__ghdl_text_file_close");
pragma Export (C, Ghdl_File_Close, "__ghdl_file_close");
+
+ pragma Export (C, Ghdl_File_Flush, "__ghdl_file_flush");
end Grt.Files;
diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
index 005bc89e2..30c58ab41 100644
--- a/translate/grt/grt-vstrings.adb
+++ b/translate/grt/grt-vstrings.adb
@@ -338,4 +338,85 @@ package body Grt.Vstrings is
Last := P - 1;
end To_String;
+ procedure To_String (Str : out String_Real_Digits;
+ Last : out Natural;
+ N : Ghdl_F64;
+ Nbr_Digits : Ghdl_I32)
+ is
+ procedure Snprintf_Nf (Str : in out String;
+ Len : Natural;
+ Ndigits : Ghdl_I32;
+ V : Ghdl_F64);
+ pragma Import (C, Snprintf_Nf, "__ghdl_snprintf_nf");
+ begin
+ Snprintf_Nf (Str, Str'Length, Nbr_Digits, N);
+ Last := strlen (To_Ghdl_C_String (Str'Address));
+ end To_String;
+
+ procedure To_String (Str : out String_Real_Digits;
+ Last : out Natural;
+ N : Ghdl_F64;
+ Format : Ghdl_C_String)
+ is
+ procedure Snprintf_Fmtf (Str : in out String;
+ Len : Natural;
+ Format : Ghdl_C_String;
+ V : Ghdl_F64);
+ pragma Import (C, Snprintf_Fmtf, "__ghdl_snprintf_fmtf");
+ begin
+ -- FIXME: check format ('%', f/g/e/a)
+ Snprintf_Fmtf (Str, Str'Length, Format, N);
+ Last := strlen (To_Ghdl_C_String (Str'Address));
+ end To_String;
+
+ procedure To_String (Str : out String_Time_Unit;
+ First : out Natural;
+ Value : Ghdl_I64;
+ Unit : Ghdl_I64)
+ is
+ V, U : Ghdl_I64;
+ D : Natural;
+ P : Natural := Str'Last;
+ Has_Digits : Boolean;
+ begin
+ -- Always work on negative values.
+ if Value > 0 then
+ V := -Value;
+ else
+ V := Value;
+ end if;
+
+ Has_Digits := False;
+ U := Unit;
+ loop
+ if U = 1 then
+ if Has_Digits then
+ Str (P) := '.';
+ P := P - 1;
+ else
+ Has_Digits := True;
+ end if;
+ end if;
+
+ D := Natural (-(V rem 10));
+ if D /= 0 or else Has_Digits then
+ Str (P) := Character'Val (48 + D);
+ P := P - 1;
+ Has_Digits := True;
+ end if;
+ U := U / 10;
+ V := V / 10;
+ exit when V = 0 and then U = 0;
+ end loop;
+ if not Has_Digits then
+ Str (P) := '0';
+ else
+ P := P + 1;
+ end if;
+ if Value < 0 then
+ P := P - 1;
+ Str (P) := '-';
+ end if;
+ First := P;
+ end To_String;
end Grt.Vstrings;
diff --git a/translate/grt/grt-vstrings.ads b/translate/grt/grt-vstrings.ads
index 0f5938edc..94967bb0f 100644
--- a/translate/grt/grt-vstrings.ads
+++ b/translate/grt/grt-vstrings.ads
@@ -77,18 +77,49 @@ package Grt.Vstrings is
-- Copy RSTR to STR, and return length of the string to LEN.
procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural);
- -- FIRST is the index of the first character.
+ -- Write the image of N into STR padded to the right. FIRST is the index
+ -- of the first character, so the result is in STR (FIRST .. STR'last).
-- Requires at least 11 characters.
procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32);
+ -- Write the image of N into STR padded to the right. FIRST is the index
+ -- of the first character, so the result is in STR (FIRST .. STR'last).
-- Requires at least 21 characters.
procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64);
+ -- Write the image of N into STR. LAST is the index of the last character,
+ -- so the result is in STR (STR'first .. LAST).
-- 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);
+ subtype String_Real_Digits is String (1 .. 128);
+
+ -- Write the image of N into STR using NBR_DIGITS digits after the decimal
+ -- point.
+ procedure To_String (Str : out String_Real_Digits;
+ Last : out Natural;
+ N : Ghdl_F64;
+ Nbr_Digits : Ghdl_I32);
+
+ subtype String_Real_Format is String (1 .. 128);
+
+ -- Write the image of N into STR using NBR_DIGITS digits after the decimal
+ -- point.
+ procedure To_String (Str : out String_Real_Digits;
+ Last : out Natural;
+ N : Ghdl_F64;
+ Format : Ghdl_C_String);
+
+ -- Write the image of VALUE to STR using UNIT as unit. The output is in
+ -- STR (FIRST .. STR'last).
+ subtype String_Time_Unit is String (1 .. 22);
+ procedure To_String (Str : out String_Time_Unit;
+ First : out Natural;
+ Value : Ghdl_I64;
+ Unit : Ghdl_I64);
+
private
subtype Fat_String is String (Positive);
type Fat_String_Acc is access Fat_String;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-09 14:56:59 +0000