aboutsummaryrefslogtreecommitdiffstats
path: root/translate
diff options
context:
space:
mode:
authorgingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7>2005-10-09 17:27:11 +0000
committergingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7>2005-10-09 17:27:11 +0000
commit70cc586c068c297bdd1fbb0285473246f8812655 (patch)
treec8b7d3fba77073d79d2c7f88bb29e722caf74362 /translate
parent637d7c01c8c5d577f590f0d6891ab214697255b9 (diff)
downloadghdl-70cc586c068c297bdd1fbb0285473246f8812655.tar.gz
ghdl-70cc586c068c297bdd1fbb0285473246f8812655.tar.bz2
ghdl-70cc586c068c297bdd1fbb0285473246f8812655.zip
--vcdz option added,
switched to gcc-4.0.2, can be compiled with GNAT GPL 2005 ready for ada05 (interface identifier not used anymore) bug fixes
Diffstat (limited to 'translate')
-rw-r--r--translate/gcc/Make-lang.in2
-rw-r--r--translate/gcc/Makefile.in2
-rw-r--r--translate/gcc/README2
-rw-r--r--translate/gcc/config-lang.in2
-rwxr-xr-xtranslate/gcc/dist.sh59
-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
-rw-r--r--translate/translation.adb8
29 files changed, 350 insertions, 105 deletions
diff --git a/translate/gcc/Make-lang.in b/translate/gcc/Make-lang.in
index 2aa27a1e0..cb7335c49 100644
--- a/translate/gcc/Make-lang.in
+++ b/translate/gcc/Make-lang.in
@@ -68,7 +68,7 @@ agcc_objdir=.
AGCC_GCCSRC_DIR=$(srcdir)/..
AGCC_GCCOBJ_DIR=..
-####agcc Makefile.inc
+####gcc Makefile.inc
# The compiler proper.
# It is compiled into the vhdl/ subdirectory to avoid file name clashes but
diff --git a/translate/gcc/Makefile.in b/translate/gcc/Makefile.in
index f459e6a09..2757b907c 100644
--- a/translate/gcc/Makefile.in
+++ b/translate/gcc/Makefile.in
@@ -176,7 +176,7 @@ drvdir/default_pathes.ads: drvdir Makefile
echo " Prefix : constant String :=">> tmp-dpathes.ads
echo " \"$(libsubdir)/vhdl/lib/\";" >> tmp-dpathes.ads
echo "end Default_Pathes;" >> tmp-dpathes.ads
- $(srcdir)/../move-if-change tmp-dpathes.ads $@
+ $(srcdir)/../../move-if-change tmp-dpathes.ads $@
../ghdl$(exeext): drvdir drvdir/default_pathes.ads force
CURDIR=`pwd`; cd $(srcdir); SRCDIR=`pwd`; cd $$CURDIR/drvdir; \
diff --git a/translate/gcc/README b/translate/gcc/README
index a3df511af..d7bab3281 100644
--- a/translate/gcc/README
+++ b/translate/gcc/README
@@ -29,7 +29,7 @@ Building GHDL from sources:
Required:
* the sources of @GCCVERSION@ (at least the core part).
Note: other versions of gcc sources have not been tested.
-* the Ada95 GNAT compiler (only GNAT v3.15p is known to work).
+* the Ada95 GNAT compiler (GNAT v3.15p and GNAT GPL 2005 are known to work).
* GNU/Linux for ix86 (pc systems) (porting is necessary for other systems)
Procedure:
diff --git a/translate/gcc/config-lang.in b/translate/gcc/config-lang.in
index 393d2277f..7010b1127 100644
--- a/translate/gcc/config-lang.in
+++ b/translate/gcc/config-lang.in
@@ -35,4 +35,4 @@ stagestuff="ghdl\$(exeext) ghdl1\$(exeext)"
outputs=vhdl/Makefile
-gtfiles="\$(srcdir)/vhdl/agcc-bindings.c"
+gtfiles="\$(srcdir)/vhdl/ortho-lang.c"
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh
index a946e4602..c2cd8f16f 100755
--- a/translate/gcc/dist.sh
+++ b/translate/gcc/dist.sh
@@ -38,14 +38,14 @@
set -e
-VERSION=`sed -n -e 's/.*GHDL \([0-9.]*\) (.*/\1/p' ../../version.ads`
+VERSION=`sed -n -e 's/.*GHDL \([0-9.a-z]*\) (.*/\1/p' ../../version.ads`
CWD=`pwd`
distdir=ghdl-$VERSION
tarfile=$distdir.tar
-GCCVERSION=3.4.3
+GCCVERSION=4.0.2
DISTDIR=/home/gingold/dist
GCCDIST=$DISTDIR/gcc-$GCCVERSION
GCCDISTOBJ=$GCCDIST-objs
@@ -80,7 +80,7 @@ do_Makefile ()
sed -e "/^####libraries Makefile.inc/r ../../libraries/Makefile.inc" \
-e "/^####grt Makefile.inc/r ../grt/Makefile.inc" \
< Makefile.in > $VHDLDIR/Makefile.in
- sed -e "/^####agcc Makefile.inc/r ../../ortho/agcc/Makefile.inc" \
+ sed -e "/^####gcc Makefile.inc/r ../../ortho/gcc/Makefile.inc" \
< Make-lang.in > $VHDLDIR/Make-lang.in
}
@@ -194,55 +194,22 @@ ortho_front.ads"
for i in $ortho_files; do ln -sf $CWD/../../ortho/$i $VHDLDIR/$i; done
ortho_gcc_files="
-agcc-fe.adb
lang.opt
-ortho_ident.adb
-ortho_ident.ads
-ortho_gcc_front.ads
-ortho_nodes.ads
+ortho-lang.c
ortho_gcc-main.adb
ortho_gcc-main.ads
+ortho_gcc.adb
ortho_gcc.ads
-ortho_gcc.adb"
+ortho_gcc_front.ads
+ortho_ident.adb
+ortho_ident.ads
+ortho_nodes.ads
+"
for i in $ortho_gcc_files; do
ln -sf $CWD/../../ortho/gcc/$i $VHDLDIR/$i
done
-agcc_files="
-agcc-autils.adb
-agcc-autils.ads
-agcc-convert.ads
-agcc-fe.ads
-agcc-ggc.ads
-agcc-output.ads
-agcc-rtl.ads
-agcc-stor_layout.ads
-agcc-toplev.ads
-agcc-trees.adb
-agcc-diagnostic.ads
-agcc-libiberty.ads
-agcc.ads
-agcc.adb
-c.adb
-c.ads
-agcc-hconfig.ads.in
-agcc-hwint.ads.in
-agcc-machmode.ads.in
-agcc-real.ads.in
-agcc-tm.ads.in
-agcc-trees.ads.in
-agcc-options.ads.in
-agcc-input.ads
-agcc-bindings.c
-agcc-ghdl.c
-gen_tree.c"
-
-
-for i in $agcc_files; do
- ln -sf $CWD/../../ortho/agcc/$i $VHDLDIR/$i
-done
-
ghdl_files="
ghdl_gcc.adb
ghdldrv.ads
@@ -347,12 +314,16 @@ grt-stack2.adb
grt-stack2.ads
grt-stacks.adb
grt-stacks.ads
+grt-c.ads
+grt-zlib.ads
grt-stdio.ads
grt-astdio.ads
grt-astdio.adb
grt-types.ads
grt-vcd.adb
grt-vcd.ads
+grt-vcdz.adb
+grt-vcdz.ads
grt-vital_annotate.adb
grt-vital_annotate.ads
grt-vpi.adb
@@ -497,7 +468,7 @@ do_tar_dist ()
rm -rf $bindirname
mkdir $bindirname
sed -e "s/@TARFILE@/$dir.tar/" < INSTALL > $bindirname/INSTALL
- ln COPYING $bindirname
+ ln ../../COPYING $bindirname
ln $TARINSTALL $bindirname
tar cvf $bindirname.tar $bindirname
}
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
index 827e69851..984729246 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 3c19cc851..de28094d1 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 000000000..33fb36cef
--- /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 9bd803534..a40f0edfe 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 47e5ac6ce..28ad75db5 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 ab73b2d24..0fdf01d23 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 d0063226a..151549712 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 8b85d59ec..e322f4775 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 db57dc81c..99ac86ca8 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 be4fc8665..46ed04e2d 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 a4e269bf9..c0dee2bcb 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 9d329781c..c7391ccb4 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 9ed8a3227..638c37572 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 9e3259cd0..284cc6a91 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 fad33226b..b600416f2 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 66f248c5d..f9fd174d2 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 40b9d8c5e..a6d79b402 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 000000000..7b5144ee2
--- /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 000000000..c213efb16
--- /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 0609d466c..f6c5c56ad 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 17c64e3da..d17cc87ea 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 93f217e82..c571cfabf 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 000000000..6b674ca03
--- /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;
diff --git a/translate/translation.adb b/translate/translation.adb
index 8f3c66172..9e1f3a444 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -13961,7 +13961,7 @@ package body Translation is
Right_Type : Iir;
Res_Otype : O_Tnode;
Op : ON_Op_Kind;
- Interface : Iir;
+ Inter : Iir;
Res : O_Enode;
begin
Kind := Get_Implicit_Definition (Imp);
@@ -13970,18 +13970,18 @@ package body Translation is
end if;
Res_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
- Interface := Get_Interface_Declaration_Chain (Imp);
+ Inter := Get_Interface_Declaration_Chain (Imp);
if Left = Null_Iir then
Left_Tree := O_Enode_Null;
else
- Left_Type := Get_Type (Interface);
+ Left_Type := Get_Type (Inter);
Left_Tree := Translate_Expression (Left, Left_Type);
end if;
if Right = Null_Iir then
Right_Tree := O_Enode_Null;
else
- Right_Type := Get_Type (Get_Chain (Interface));
+ Right_Type := Get_Type (Get_Chain (Inter));
Right_Tree := Translate_Expression (Right, Right_Type);
end if;