diff options
| -rw-r--r-- | src/grt/grt-disp_signals.adb | 1 | ||||
| -rw-r--r-- | src/grt/grt-rtis_utils.adb | 1 | ||||
| -rw-r--r-- | src/grt/grt-vstrings.adb | 21 | ||||
| -rw-r--r-- | src/grt/grt-vstrings.ads | 9 | ||||
| -rw-r--r-- | src/grt/grt-vstrings_io.adb | 50 | ||||
| -rw-r--r-- | src/grt/grt-vstrings_io.ads | 34 |
6 files changed, 92 insertions, 24 deletions
diff --git a/src/grt/grt-disp_signals.adb b/src/grt/grt-disp_signals.adb index d3d095657..a5e9993b2 100644 --- a/src/grt/grt-disp_signals.adb +++ b/src/grt/grt-disp_signals.adb @@ -34,6 +34,7 @@ with Grt.Astdio.Vhdl; use Grt.Astdio.Vhdl; with Grt.Errors; use Grt.Errors; pragma Elaborate_All (Grt.Rtis_Utils); with Grt.Vstrings; use Grt.Vstrings; +with Grt.Vstrings_IO; use Grt.Vstrings_IO; with Grt.Options; with Grt.Processes; with Grt.Disp; use Grt.Disp; diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb index 0b7e43e2b..7f78de01c 100644 --- a/src/grt/grt-rtis_utils.adb +++ b/src/grt/grt-rtis_utils.adb @@ -25,6 +25,7 @@ with Grt.Errors; use Grt.Errors; with Grt.To_Strings; use Grt.To_Strings; +with Grt.Vstrings_IO; use Grt.Vstrings_IO; package body Grt.Rtis_Utils is diff --git a/src/grt/grt-vstrings.adb b/src/grt/grt-vstrings.adb index af982a50c..818701fa0 100644 --- a/src/grt/grt-vstrings.adb +++ b/src/grt/grt-vstrings.adb @@ -24,7 +24,6 @@ -- covered by the GNU Public License. with Grt.Errors; use Grt.Errors; -with Grt.C; use Grt.C; package body Grt.Vstrings is procedure Free (Fs : Fat_String_Acc); @@ -112,15 +111,10 @@ package body Grt.Vstrings is Vstr.Len := Len; end Truncate; - procedure Put (Stream : FILEs; Vstr : Vstring) - is - S : size_t; + function Get_Address (Vstr : Vstring) return Address is begin - S := size_t (Vstr.Len); - if S > 0 then - S := fwrite (Vstr.Str (1)'Address, S, 1, Stream); - end if; - end Put; + return Vstr.Str.all'Address; + end Get_Address; function Get_C_String (Vstr : Vstring) return Ghdl_C_String is begin @@ -212,13 +206,4 @@ package body Grt.Vstrings is Rstr.Str (Rstr.First .. Rstr.First + Len - 1); end if; end Copy; - - procedure Put (Stream : FILEs; Rstr : Rstring) - is - S : size_t; - pragma Unreferenced (S); - begin - S := fwrite (Get_Address (Rstr), size_t (Length (Rstr)), 1, Stream); - end Put; - end Grt.Vstrings; diff --git a/src/grt/grt-vstrings.ads b/src/grt/grt-vstrings.ads index 7914397a2..02d0504db 100644 --- a/src/grt/grt-vstrings.ads +++ b/src/grt/grt-vstrings.ads @@ -22,7 +22,7 @@ -- covered by the GNU General Public License. This exception does not -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. -with Grt.Stdio; use Grt.Stdio; + with Grt.Types; use Grt.Types; with System; use System; @@ -54,8 +54,8 @@ package Grt.Vstrings is -- It is an error if LEN is greater than the current length. procedure Truncate (Vstr : in out Vstring; Len : Natural); - -- Display VSTR. - procedure Put (Stream : FILEs; Vstr : Vstring); + -- Return the address of the first character of VSTR. + function Get_Address (Vstr : Vstring) return Address; -- Get VSTR as a C String. The NUL character must have been added. function Get_C_String (Vstr : Vstring) return Ghdl_C_String; @@ -77,9 +77,6 @@ package Grt.Vstrings is -- Return the address of the first character of RSTR. function Get_Address (Rstr : Rstring) return Address; - -- Display RSTR. - procedure Put (Stream : FILEs; Rstr : Rstring); - -- Copy RSTR to STR, and return length of the string to LEN. procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural); diff --git a/src/grt/grt-vstrings_io.adb b/src/grt/grt-vstrings_io.adb new file mode 100644 index 000000000..2be691acd --- /dev/null +++ b/src/grt/grt-vstrings_io.adb @@ -0,0 +1,50 @@ +-- GHDL Run Time (GRT) - IO for variable strings. +-- Copyright (C) 2019 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +with Grt.Errors; use Grt.Errors; +with Grt.C; use Grt.C; + +package body Grt.Vstrings_IO is + procedure Put (Stream : FILEs; Vstr : Vstring) + is + S : size_t; + begin + S := size_t (Length (Vstr)); + if S > 0 then + S := fwrite (Get_Address (Vstr), S, 1, Stream); + end if; + end Put; + + procedure Put (Stream : FILEs; Rstr : Rstring) + is + S : size_t; + begin + S := size_t (Length (Rstr)); + if S > 0 then + S := fwrite (Get_Address (Rstr), S, 1, Stream); + end if; + end Put; + +end Grt.Vstrings_IO; diff --git a/src/grt/grt-vstrings_io.ads b/src/grt/grt-vstrings_io.ads new file mode 100644 index 000000000..82f796149 --- /dev/null +++ b/src/grt/grt-vstrings_io.ads @@ -0,0 +1,34 @@ +-- GHDL Run Time (GRT) - IO for variable strings. +-- Copyright (C) 2019 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. +with Grt.Stdio; use Grt.Stdio; +with Grt.Vstrings; use Grt.Vstrings; + +package Grt.Vstrings_IO is + -- Display VSTR. + procedure Put (Stream : FILEs; Vstr : Vstring); + + -- Display RSTR. + procedure Put (Stream : FILEs; Rstr : Rstring); +end Grt.Vstrings_IO; |