diff options
author | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2005-10-09 17:27:11 +0000 |
---|---|---|
committer | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2005-10-09 17:27:11 +0000 |
commit | 70cc586c068c297bdd1fbb0285473246f8812655 (patch) | |
tree | c8b7d3fba77073d79d2c7f88bb29e722caf74362 /translate | |
parent | 637d7c01c8c5d577f590f0d6891ab214697255b9 (diff) | |
download | ghdl-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')
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; |