vhdl 2008: visibility, more implicit subprograms, alias...

Use Type_Definition in type_declarator.

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;