summaryrefslogtreecommitdiff
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/ghwlib.c4
-rw-r--r--translate/grt/grt-astdio.adb2
-rw-r--r--translate/grt/grt-c.ads36
-rw-r--r--translate/grt/grt-disp.adb1
-rw-r--r--translate/grt/grt-disp_rti.adb4
-rw-r--r--translate/grt/grt-disp_signals.adb1
-rw-r--r--translate/grt/grt-files.adb1
-rw-r--r--translate/grt/grt-images.adb1
-rw-r--r--translate/grt/grt-main.adb3
-rw-r--r--translate/grt/grt-names.adb1
-rw-r--r--translate/grt/grt-processes.adb1
-rw-r--r--translate/grt/grt-sdf.adb2
-rw-r--r--translate/grt/grt-signals.adb1
-rw-r--r--translate/grt/grt-stats.adb1
-rw-r--r--translate/grt/grt-stdio.ads12
-rw-r--r--translate/grt/grt-vcd.adb118
-rw-r--r--translate/grt/grt-vcd.ads12
-rw-r--r--translate/grt/grt-vcdz.adb112
-rw-r--r--translate/grt/grt-vcdz.ads21
-rw-r--r--translate/grt/grt-vpi.adb2
-rw-r--r--translate/grt/grt-vstrings.adb2
-rw-r--r--translate/grt/grt-waves.adb2
-rw-r--r--translate/grt/grt-zlib.ads40
23 files changed, 327 insertions, 53 deletions
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
index 827e698..9847292 100644
--- a/translate/grt/ghwlib.c
+++ b/translate/grt/ghwlib.c
@@ -1147,10 +1147,10 @@ ghw_read_cycle_cont (struct ghw_handler *h, int *list)
list_p = list;
while (1)
{
- int32_t d;
+ uint32_t d;
/* Read delta to next signal. */
- if (ghw_read_sleb128 (h, &d) < 0)
+ if (ghw_read_uleb128 (h, &d) < 0)
return -1;
if (d == 0)
{
diff --git a/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb
index 3c19cc8..de28094 100644
--- a/translate/grt/grt-astdio.adb
+++ b/translate/grt/grt-astdio.adb
@@ -15,6 +15,8 @@
-- 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.
+with Grt.C; use Grt.C;
+
package body Grt.Astdio is
procedure Put (Stream : FILEs; Str : String)
is
diff --git a/translate/grt/grt-c.ads b/translate/grt/grt-c.ads
new file mode 100644
index 0000000..33fb36c
--- /dev/null
+++ b/translate/grt/grt-c.ads
@@ -0,0 +1,36 @@
+-- GHDL Run Time (GRT) - C interface.
+-- Copyright (C) 2005 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.
+
+-- This package declares C types.
+-- It is a really stripped down version of interfaces.C!
+with System;
+
+package Grt.C is
+ pragma Preelaborate (Grt.C);
+
+ -- Type void * and char *.
+ subtype voids is System.Address;
+ subtype chars is System.Address;
+ subtype long is Long_Integer;
+
+ -- Type size_t.
+ type size_t is mod 2 ** Standard'Address_Size;
+
+ -- Type int. It is an alias on Integer for simplicity.
+ subtype int is Integer;
+end Grt.C;
diff --git a/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb
index 9bd8035..a40f0ed 100644
--- a/translate/grt/grt-disp.adb
+++ b/translate/grt/grt-disp.adb
@@ -15,6 +15,7 @@
-- 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.
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Types; use Grt.Types;
with Grt.Signals; use Grt.Signals;
with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index 47e5ac6..28ad75d 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -21,7 +21,6 @@ with Grt.Stdio; use Grt.Stdio;
with Grt.Astdio; use Grt.Astdio;
with Grt.Types; use Grt.Types;
with Grt.Errors; use Grt.Errors;
---with Grt.Typedesc; use Grt.Typedesc;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Options; use Grt.Options;
@@ -649,7 +648,8 @@ package body Grt.Disp_Rti is
Put (" := ");
-- FIXME: put this into a function.
- if Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+ if (Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+ or Obj_Type.Kind = Ghdl_Rtik_Type_Record)
and then Obj_Type.Mode = 1
then
Addr := To_Addr_Acc (Addr).all;
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
index ab73b2d..0fdf01d 100644
--- a/translate/grt/grt-disp_signals.adb
+++ b/translate/grt/grt-disp_signals.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System; use System;
+with System.Storage_Elements; -- Work around GNAT bug.
with Ada.Unchecked_Conversion;
with Grt.Types; use Grt.Types;
with Grt.Rtis; use Grt.Rtis;
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index d006322..1515497 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with Grt.Errors; use Grt.Errors;
with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
with GNAT.Table;
with System; use System;
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 8b85d59..e322f47 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System; use System;
+with System.Storage_Elements; -- Work around GNAT bug.
with Ada.Unchecked_Conversion;
with Grt.Processes; use Grt.Processes;
with Grt.Vstrings; use Grt.Vstrings;
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index db57dc8..99ac86c 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -15,9 +15,11 @@
-- 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.
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Types; use Grt.Types;
with Grt.Errors;
with Grt.Vcd;
+with Grt.Vcdz;
with Grt.Vpi;
with Grt.Waves;
with Grt.Stacks;
@@ -83,6 +85,7 @@ package body Grt.Main is
begin
-- List of modules to be registered.
Grt.Vcd.Register;
+ Grt.Vcdz.Register;
Grt.Waves.Register;
Grt.Vpi.Register;
Grt.Vital_Annotate.Register;
diff --git a/translate/grt/grt-names.adb b/translate/grt/grt-names.adb
index be4fc86..46ed04e 100644
--- a/translate/grt/grt-names.adb
+++ b/translate/grt/grt-names.adb
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
--with Grt.Errors; use Grt.Errors;
with Ada.Unchecked_Conversion;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Processes; use Grt.Processes;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Rtis_Utils; use Grt.Rtis_Utils;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index a4e269b..c0dee2b 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -18,6 +18,7 @@
with GNAT.Table;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Stack2; use Grt.Stack2;
with Grt.Disp;
with Grt.Astdio;
diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
index 9d32978..c7391cc 100644
--- a/translate/grt/grt-sdf.adb
+++ b/translate/grt/grt-sdf.adb
@@ -15,8 +15,10 @@
-- 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.
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Types; use Grt.Types;
with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
with Grt.Errors; use Grt.Errors;
with Ada.Characters.Latin_1;
with Ada.Unchecked_Deallocation;
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 9ed8a32..638c375 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System; use System;
+with System.Storage_Elements; -- Work around GNAT bug.
with Ada.Unchecked_Deallocation;
with Ada.Unchecked_Conversion;
with Grt.Errors; use Grt.Errors;
diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
index 9e3259c..284cc6a 100644
--- a/translate/grt/grt-stats.adb
+++ b/translate/grt/grt-stats.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System; use System;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Stdio; use Grt.Stdio;
with Grt.Astdio; use Grt.Astdio;
with Grt.Signals;
diff --git a/translate/grt/grt-stdio.ads b/translate/grt/grt-stdio.ads
index fad3322..b600416 100644
--- a/translate/grt/grt-stdio.ads
+++ b/translate/grt/grt-stdio.ads
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with System;
+with Grt.C; use Grt.C;
-- This package provides a thin binding to the stdio.h of the C library.
-- It mimics GNAT package Interfaces.C_Streams.
@@ -35,17 +36,6 @@ package Grt.Stdio is
function stderr return FILEs;
function stdin return FILEs;
- -- Type void * and char *.
- subtype voids is System.Address;
- subtype chars is System.Address;
- subtype long is Long_Integer;
-
- -- Type size_t.
- type size_t is mod 2 ** Standard'Address_Size;
-
- -- Type int. It is an alias on Integer for simplicity.
- subtype int is Integer;
-
-- The following subprograms are translation of the C prototypes.
function fopen (path: chars; mode : chars) return FILEs;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
index 66f248c..f9fd174 100644
--- a/translate/grt/grt-vcd.adb
+++ b/translate/grt/grt-vcd.adb
@@ -18,22 +18,52 @@
with Interfaces;
with Grt.Stdio; use Grt.Stdio;
with System; use System;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Errors; use Grt.Errors;
with Grt.Types; use Grt.Types;
with Grt.Signals; use Grt.Signals;
with GNAT.Table;
with Grt.Astdio; use Grt.Astdio;
+with Grt.C; use Grt.C;
with Grt.Hooks; use Grt.Hooks;
with Grt.Avhpi; use Grt.Avhpi;
with Grt.Rtis; use Grt.Rtis;
with Grt.Rtis_Addr; use Grt.Rtis_Addr;
with Grt.Rtis_Types; use Grt.Rtis_Types;
+with Grt.Vstrings;
package body Grt.Vcd is
+ type Vcd_IO_Simple is new Vcd_IO_Handler with record
+ Stream : FILEs;
+ end record;
+ type IO_Simple_Acc is access Vcd_IO_Simple;
+ procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String);
+ procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character);
+ procedure Vcd_Close (Handler : access Vcd_IO_Simple);
+
+ procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String)
+ is
+ R : size_t;
+ begin
+ R := fwrite (Str'Address, Str'Length, 1, Handler.Stream);
+ end Vcd_Put;
+
+ procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character)
+ is
+ R : int;
+ begin
+ R := fputc (Character'Pos (C), Handler.Stream);
+ end Vcd_Putc;
+
+ procedure Vcd_Close (Handler : access Vcd_IO_Simple) is
+ begin
+ fclose (Handler.Stream);
+ Handler.Stream := NULL_Stream;
+ end Vcd_Close;
+
-- VCD filename.
- Vcd_Filename : String_Access := null;
-- Stream corresponding to the VCD filename.
- Vcd_Stream : FILEs;
+ --Vcd_Stream : FILEs;
-- Index type of the table of vcd variables to dump.
type Vcd_Index_Type is new Integer;
@@ -42,15 +72,37 @@ package body Grt.Vcd is
function Vcd_Option (Opt : String) return Boolean
is
F : Natural := Opt'First;
+ Mode : constant String := "wt" & NUL;
+ Handler : IO_Simple_Acc;
+ Vcd_Filename : String_Access;
begin
if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
return False;
end if;
if Opt'Length > 6 and then Opt (F + 5) = '=' then
+ if H /= null then
+ Error ("--vcd: file already set");
+ return True;
+ end if;
+
-- Add an extra NUL character.
Vcd_Filename := new String (1 .. Opt'Length - 6 + 1);
Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+ Handler := new Vcd_IO_Simple;
+ if Vcd_Filename.all = "-" & NUL then
+ Handler.Stream := stdout;
+ else
+ Handler.Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+ if Handler.Stream = NULL_Stream then
+ Error_C ("cannot open ");
+ Error_E (Vcd_Filename (Vcd_Filename'First
+ .. Vcd_Filename'Last - 1));
+ return True;
+ end if;
+ end if;
+ H := Handler_Acc (Handler);
return True;
else
return False;
@@ -62,28 +114,24 @@ package body Grt.Vcd is
Put_Line (" --vcd=FILENAME dump signal values into a VCD file");
end Vcd_Help;
- procedure Vcd_Put (Str : String)
- is
- R : size_t;
+ procedure Vcd_Put (Str : String) is
begin
- R := fwrite (Str'Address, Str'Length, 1, Vcd_Stream);
+ Vcd_Put (H, Str);
end Vcd_Put;
- procedure Vcd_Putc (C : Character)
- is
- R : int;
+ procedure Vcd_Putc (C : Character) is
begin
- R := fputc (Character'Pos (C), Vcd_Stream);
+ Vcd_Putc (H, C);
end Vcd_Putc;
procedure Vcd_Newline is
begin
- Vcd_Putc (Nl);
+ Vcd_Putc (H, Nl);
end Vcd_Newline;
procedure Vcd_Putline (Str : String) is
begin
- Vcd_Put (Str);
+ Vcd_Put (H, Str);
Vcd_Newline;
end Vcd_Putline;
@@ -95,8 +143,11 @@ package body Grt.Vcd is
procedure Vcd_Put_I32 (V : Ghdl_I32)
is
+ Str : String (1 .. 11);
+ First : Natural;
begin
- Put_I32 (Vcd_Stream, V);
+ Vstrings.To_String (Str, First, V);
+ Vcd_Put (Str (First .. Str'Last));
end Vcd_Put_I32;
procedure Vcd_Put_Idcode (N : Vcd_Index_Type)
@@ -139,23 +190,10 @@ package body Grt.Vcd is
-- Called before elaboration.
procedure Vcd_Init
is
- Mode : constant String := "wt" & NUL;
begin
- if Vcd_Filename = null then
- Vcd_Stream := NULL_Stream;
+ if H = null then
return;
end if;
- if Vcd_Filename.all = "-" & NUL then
- Vcd_Stream := stdout;
- else
- Vcd_Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
- if Vcd_Stream = NULL_Stream then
- Error_C ("cannot open ");
- Error_E (Vcd_Filename (Vcd_Filename'First
- .. Vcd_Filename'Last - 1));
- return;
- end if;
- end if;
Vcd_Putline ("$date");
Vcd_Put (" ");
declare
@@ -165,13 +203,17 @@ package body Grt.Vcd is
function time (Addr : Address) return time_t;
pragma Import (C, time);
- function ctime (Timep: Address) return chars;
+ function ctime (Timep: Address) return Ghdl_C_String;
pragma Import (C, ctime);
- R : int;
+ Ct : Ghdl_C_String;
begin
Cur_Time := time (Null_Address);
- R := fputs (ctime (Cur_Time'Address), Vcd_Stream);
+ Ct := ctime (Cur_Time'Address);
+ for I in Positive loop
+ exit when Ct (I) = NUL;
+ Vcd_Putc (Ct (I));
+ end loop;
-- Note: ctime already append a LF.
end;
Vcd_Put_End;
@@ -639,9 +681,12 @@ package body Grt.Vcd is
procedure Vcd_Put_Time
is
+ Str : String (1 .. 21);
+ First : Natural;
begin
Vcd_Putc ('#');
- Put_I64 (Vcd_Stream, Ghdl_I64 (Cycle_Time));
+ Vstrings.To_String (Str, First, Ghdl_I64 (Cycle_Time));
+ Vcd_Put (Str (First .. Str'Last));
Vcd_Newline;
end Vcd_Put_Time;
@@ -653,7 +698,7 @@ package body Grt.Vcd is
Root : VhpiHandleT;
begin
-- Do nothing if there is no VCD file to generate.
- if Vcd_Stream = NULL_Stream then
+ if H = null then
return;
end if;
@@ -674,11 +719,6 @@ package body Grt.Vcd is
-- Called before each non delta cycle.
procedure Vcd_Cycle is
begin
- -- Do nothing if there is no VCD file to generate.
- if Vcd_Stream = NULL_Stream then
- return;
- end if;
-
-- Disp values.
Vcd_Put_Time;
if Cycle_Time = 0 then
@@ -699,7 +739,9 @@ package body Grt.Vcd is
-- Called at the end of the simulation.
procedure Vcd_End is
begin
- null;
+ if H /= null then
+ Vcd_Close (H);
+ end if;
end Vcd_End;
Vcd_Hooks : aliased constant Hooks_Type :=
diff --git a/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads
index 40b9d8c..a6d79b4 100644
--- a/translate/grt/grt-vcd.ads
+++ b/translate/grt/grt-vcd.ads
@@ -20,6 +20,18 @@ with Grt.Types; use Grt.Types;
with Grt.Avhpi; use Grt.Avhpi;
package Grt.Vcd is
+ -- Abstract type for IO.
+ type Vcd_IO_Handler is abstract tagged null record;
+ procedure Vcd_Put (Handler : access Vcd_IO_Handler; Str : String)
+ is abstract;
+ procedure Vcd_Putc (Handler : access Vcd_IO_Handler; C : Character)
+ is abstract;
+ procedure Vcd_Close (Handler : access Vcd_IO_Handler)
+ is abstract;
+
+ type Handler_Acc is access all Vcd_IO_Handler'Class;
+ H : Handler_Acc := null;
+
type Vcd_Var_Kind is (Vcd_Bad,
Vcd_Bool,
Vcd_Integer32,
diff --git a/translate/grt/grt-vcdz.adb b/translate/grt/grt-vcdz.adb
new file mode 100644
index 0000000..7b5144e
--- /dev/null
+++ b/translate/grt/grt-vcdz.adb
@@ -0,0 +1,112 @@
+-- GHDL Run Time (GRT) - VCD .gz module.
+-- Copyright (C) 2005 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.
+with System.Storage_Elements; -- Work around GNAT bug.
+with Grt.Vcd; use Grt.Vcd;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Zlib; use Grt.Zlib;
+with Grt.C; use Grt.C;
+
+package body Grt.Vcdz is
+ type Vcd_IO_Gzip is new Vcd_IO_Handler with record
+ Stream : gzFile;
+ end record;
+ type IO_Gzip_Acc is access Vcd_IO_Gzip;
+ procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String);
+ procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character);
+ procedure Vcd_Close (Handler : access Vcd_IO_Gzip);
+
+ procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String)
+ is
+ R : int;
+ begin
+ R := gzwrite (Handler.Stream, Str'Address, Str'Length);
+ end Vcd_Put;
+
+ procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character)
+ is
+ R : int;
+ begin
+ R := gzputc (Handler.Stream, Character'Pos (C));
+ end Vcd_Putc;
+
+ procedure Vcd_Close (Handler : access Vcd_IO_Gzip) is
+ begin
+ gzclose (Handler.Stream);
+ Handler.Stream := NULL_gzFile;
+ end Vcd_Close;
+
+ -- VCD filename.
+
+ -- Return TRUE if OPT is an option for VCD.
+ function Vcdz_Option (Opt : String) return Boolean
+ is
+ F : Natural := Opt'First;
+ Vcd_Filename : String_Access := null;
+ Handler : IO_Gzip_Acc;
+ Mode : constant String := "wb" & NUL;
+ begin
+ if Opt'Length < 7 or else Opt (F .. F + 6) /= "--vcdgz" then
+ return False;
+ end if;
+ if Opt'Length > 7 and then Opt (F + 7) = '=' then
+ if H /= null then
+ Error ("--vcdz: file already set");
+ return True;
+ end if;
+
+ -- Add an extra NUL character.
+ Vcd_Filename := new String (1 .. Opt'Length - 8 + 1);
+ Vcd_Filename (1 .. Opt'Length - 8) := Opt (F + 8 .. Opt'Last);
+ Vcd_Filename (Vcd_Filename'Last) := NUL;
+
+ Handler := new Vcd_IO_Gzip;
+ Handler.Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
+ if Handler.Stream = NULL_gzFile then
+ Error_C ("cannot open ");
+ Error_E (Vcd_Filename (Vcd_Filename'First
+ .. Vcd_Filename'Last - 1));
+ return True;
+ end if;
+ H := Handler_Acc (Handler);
+ return True;
+ else
+ return False;
+ end if;
+ end Vcdz_Option;
+
+ procedure Vcdz_Help is
+ begin
+ Put_Line
+ (" --vcdgz=FILENAME dump signal values into a VCD gzip'ed file");
+ end Vcdz_Help;
+
+ Vcdz_Hooks : aliased constant Hooks_Type :=
+ (Option => Vcdz_Option'Access,
+ Help => Vcdz_Help'Access,
+ Init => Proc_Hook_Nil'Access,
+ Start => Proc_Hook_Nil'Access,
+ Finish => Proc_Hook_Nil'Access);
+
+ procedure Register is
+ begin
+ Register_Hooks (Vcdz_Hooks'Access);
+ end Register;
+end Grt.Vcdz;
diff --git a/translate/grt/grt-vcdz.ads b/translate/grt/grt-vcdz.ads
new file mode 100644
index 0000000..c213efb
--- /dev/null
+++ b/translate/grt/grt-vcdz.ads
@@ -0,0 +1,21 @@
+-- GHDL Run Time (GRT) - VCD .gz module.
+-- Copyright (C) 2005 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.
+
+package Grt.Vcdz is
+ procedure Register;
+end Grt.Vcdz;
diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb
index 0609d46..f6c5c56 100644
--- a/translate/grt/grt-vpi.adb
+++ b/translate/grt/grt-vpi.adb
@@ -39,7 +39,9 @@
-------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
with Grt.Signals; use Grt.Signals;
with GNAT.Table;
with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
index 17c64e3..d17cc87 100644
--- a/translate/grt/grt-vstrings.adb
+++ b/translate/grt/grt-vstrings.adb
@@ -15,7 +15,9 @@
-- 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.
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Errors; use Grt.Errors;
+with Grt.C; use Grt.C;
package body Grt.Vstrings is
procedure Free (Fs : Fat_String_Acc);
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index 93f217e..c571cfa 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -18,9 +18,11 @@
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces; use Interfaces;
+with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Types; use Grt.Types;
with Grt.Avhpi; use Grt.Avhpi;
with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
with Grt.Errors; use Grt.Errors;
with Grt.Types; use Grt.Types;
with Grt.Astdio; use Grt.Astdio;
diff --git a/translate/grt/grt-zlib.ads b/translate/grt/grt-zlib.ads
new file mode 100644
index 0000000..6b674ca
--- /dev/null
+++ b/translate/grt/grt-zlib.ads
@@ -0,0 +1,40 @@
+-- GHDL Run Time (GRT) - Zlib binding.
+-- Copyright (C) 2005 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.
+
+with System; use System;
+with Grt.C; use Grt.C;
+
+package Grt.Zlib is
+ pragma Linker_Options ("-lz");
+
+ type gzFile is new System.Address;
+
+ NULL_gzFile : constant gzFile := gzFile (System'To_Address (0));
+
+ function gzputc (File : gzFile; C : int) return int;
+ pragma Import (C, gzputc);
+
+ function gzwrite (File : gzFile; Buf : voids; Len : int) return int;
+ pragma Import (C, gzwrite);
+
+ function gzopen (Path : chars; Mode : chars) return gzFile;
+ pragma Import (C, gzopen);
+
+ procedure gzclose (File : gzFile);
+ pragma Import (C, gzclose);
+end Grt.Zlib;
generated by cgit (git 2.34.1) at 2024-12-21 10:43:32 +0000