diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-07-17 20:34:57 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-07-17 20:34:57 +0200 |
commit | caba1d1b21d9756ede50f40d53fbc816d3b84320 (patch) | |
tree | ee0b8459472a8e7aba4ab7465bc46c74be56cd33 /translate/grt | |
parent | 1bc00453a725214de4964add2b7f8423d1a5d2da (diff) | |
download | ghdl-caba1d1b21d9756ede50f40d53fbc816d3b84320.tar.gz ghdl-caba1d1b21d9756ede50f40d53fbc816d3b84320.tar.bz2 ghdl-caba1d1b21d9756ede50f40d53fbc816d3b84320.zip |
vhdl 2008: visibility, more implicit subprograms, alias...
Use Type_Definition in type_declarator.
Diffstat (limited to 'translate/grt')
-rw-r--r-- | translate/grt/grt-cbinding.c | 13 | ||||
-rw-r--r-- | translate/grt/grt-files.adb | 23 | ||||
-rw-r--r-- | translate/grt/grt-files.ads | 4 | ||||
-rw-r--r-- | translate/grt/grt-vstrings.adb | 81 | ||||
-rw-r--r-- | translate/grt/grt-vstrings.ads | 33 |
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; |