From 70cc586c068c297bdd1fbb0285473246f8812655 Mon Sep 17 00:00:00 2001 From: gingold Date: Sun, 9 Oct 2005 17:27:11 +0000 Subject: --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 --- canon.adb | 24 +- disp_tree.adb | 31 +- disp_vhdl.adb | 31 +- doc/ghdl.texi | 14 +- evaluation.adb | 44 + ortho/gcc/Makefile | 32 + ortho/gcc/Makefile.inc | 62 ++ ortho/gcc/lang.opt | 70 ++ ortho/gcc/ortho-lang.c | 2052 ++++++++++++++++++++++++++++++++++++ ortho/gcc/ortho_gcc-main.adb | 26 + ortho/gcc/ortho_gcc-main.ads | 1 + ortho/gcc/ortho_gcc.adb | 110 ++ ortho/gcc/ortho_gcc.ads | 649 ++++++++++++ ortho/gcc/ortho_gcc_front.ads | 2 + ortho/gcc/ortho_ident.adb | 36 + ortho/gcc/ortho_ident.ads | 12 + ortho/gcc/ortho_nodes.ads | 3 + parse.adb | 75 +- sem_assocs.adb | 138 ++- sem_decls.adb | 178 ++-- sem_expr.adb | 6 +- sem_expr.ads | 5 +- sem_names.adb | 4 +- translate/gcc/Make-lang.in | 2 +- translate/gcc/Makefile.in | 2 +- translate/gcc/README | 2 +- translate/gcc/config-lang.in | 2 +- translate/gcc/dist.sh | 59 +- translate/grt/ghwlib.c | 4 +- translate/grt/grt-astdio.adb | 2 + translate/grt/grt-c.ads | 36 + translate/grt/grt-disp.adb | 1 + translate/grt/grt-disp_rti.adb | 4 +- translate/grt/grt-disp_signals.adb | 1 + translate/grt/grt-files.adb | 1 + translate/grt/grt-images.adb | 1 + translate/grt/grt-main.adb | 3 + translate/grt/grt-names.adb | 1 + translate/grt/grt-processes.adb | 1 + translate/grt/grt-sdf.adb | 2 + translate/grt/grt-signals.adb | 1 + translate/grt/grt-stats.adb | 1 + translate/grt/grt-stdio.ads | 12 +- translate/grt/grt-vcd.adb | 118 ++- translate/grt/grt-vcd.ads | 12 + translate/grt/grt-vcdz.adb | 112 ++ translate/grt/grt-vcdz.ads | 21 + translate/grt/grt-vpi.adb | 2 + translate/grt/grt-vstrings.adb | 2 + translate/grt/grt-waves.adb | 2 + translate/grt/grt-zlib.ads | 40 + translate/translation.adb | 8 +- version.ads | 3 +- 53 files changed, 3699 insertions(+), 364 deletions(-) create mode 100644 ortho/gcc/Makefile create mode 100644 ortho/gcc/Makefile.inc create mode 100644 ortho/gcc/lang.opt create mode 100644 ortho/gcc/ortho-lang.c create mode 100644 ortho/gcc/ortho_gcc-main.adb create mode 100644 ortho/gcc/ortho_gcc-main.ads create mode 100644 ortho/gcc/ortho_gcc.adb create mode 100644 ortho/gcc/ortho_gcc.ads create mode 100644 ortho/gcc/ortho_gcc_front.ads create mode 100644 ortho/gcc/ortho_ident.adb create mode 100644 ortho/gcc/ortho_ident.ads create mode 100644 ortho/gcc/ortho_nodes.ads create mode 100644 translate/grt/grt-c.ads create mode 100644 translate/grt/grt-vcdz.adb create mode 100644 translate/grt/grt-vcdz.ads create mode 100644 translate/grt/grt-zlib.ads diff --git a/canon.adb b/canon.adb index 1ac67b4e5..e9d80b6aa 100644 --- a/canon.adb +++ b/canon.adb @@ -534,7 +534,7 @@ package body Canon is is -- The canon list of association. N_Chain, Last : Iir; - Interface : Iir; + Inter : Iir; Assoc_El, Prev_Assoc_El, Next_Assoc_El : Iir; Assoc_Chain : Iir; @@ -553,8 +553,8 @@ package body Canon is -- Reorder the list of association in the interface order. -- Add missing associations. - Interface := Interface_Chain; - while Interface /= Null_Iir loop + Inter := Interface_Chain; + while Inter /= Null_Iir loop -- Search associations with INTERFACE. Found := False; Assoc_El := Assoc_Chain; @@ -562,9 +562,9 @@ package body Canon is while Assoc_El /= Null_Iir loop Next_Assoc_El := Get_Chain (Assoc_El); if Get_Formal (Assoc_El) = Null_Iir then - Set_Formal (Assoc_El, Interface); + Set_Formal (Assoc_El, Inter); end if; - if Get_Associated_Formal (Assoc_El) = Interface then + if Get_Associated_Formal (Assoc_El) = Inter then -- Remove ASSOC_EL from ASSOC_CHAIN if Prev_Assoc_El /= Null_Iir then @@ -606,11 +606,11 @@ package body Canon is Set_Artificial_Flag (Assoc_El, True); -- FIXME: association_list can be null_iir_list! --Location_Copy (Assoc_El, Association_List); - Set_Formal (Assoc_El, Interface); + Set_Formal (Assoc_El, Inter); Sub_Chain_Append (N_Chain, Last, Assoc_El); << Done >> null; - Interface := Get_Chain (Interface); + Inter := Get_Chain (Inter); end loop; pragma Assert (Assoc_Chain = Null_Iir); @@ -982,7 +982,7 @@ package body Canon is Assoc : Iir; Imp : Iir; Driver_List : Iir_Driver_List; - Interface : Iir; + Inter : Iir; Sensitivity_List : Iir_List; Is_Sensitized : Boolean; begin @@ -1043,14 +1043,14 @@ package body Canon is while Assoc /= Null_Iir loop case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => - Interface := Get_Associated_Formal (Assoc); - if Get_Mode (Interface) in Iir_In_Modes then + Inter := Get_Associated_Formal (Assoc); + if Get_Mode (Inter) in Iir_In_Modes then Canon_Extract_Sensitivity (Get_Actual (Assoc), Sensitivity_List, False); end if; -- LRM 2.1.1.2 Signal Parameters - if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration - and then Get_Mode (Interface) in Iir_Out_Modes + if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration + and then Get_Mode (Inter) in Iir_Out_Modes then if Driver_List = Null_Iir_List then Driver_List := Create_Iir_List; diff --git a/disp_tree.adb b/disp_tree.adb index 6b3203f33..8f4c967f4 100644 --- a/disp_tree.adb +++ b/disp_tree.adb @@ -16,8 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; -with System.Storage_Elements; -with Ada.Unchecked_Conversion; with Types; use Types; with Name_Table; with Iirs_Utils; use Iirs_Utils; @@ -32,27 +30,20 @@ package body Disp_Tree is Put (Blanks); end Disp_Tab; - function Addr_Image (A : System.Address) return String is - Res : String (1 .. System.Address'Size / 4); - Hex_Digits : constant array (Integer range 0 .. 15) of Character - := "0123456789abcdef"; - use System; - use System.Storage_Elements; - Addr_Num : Integer_Address := To_Integer (A); - begin - for I in reverse Res'Range loop - Res (I) := Hex_Digits (Integer (Addr_Num mod 16)); - Addr_Num := Addr_Num / 16; - end loop; - return Res; - end Addr_Image; - procedure Disp_Iir_Address (Node: Iir) is - function To_Addr is new Ada.Unchecked_Conversion - (Source => Iir, Target => System.Address); + Res : String (1 .. 10); + Hex_Digits : constant array (Int32 range 0 .. 15) of Character + := "0123456789abcdef"; + N : Int32 := Int32 (Node); begin - Put ('[' & Addr_Image (To_Addr (Node)) & ']'); + for I in reverse 2 .. 9 loop + Res (I) := Hex_Digits (N mod 16); + N := N / 16; + end loop; + Res (1) := '['; + Res (10) := ']'; + Put (Res); end Disp_Iir_Address; function Inc_Tab (Tab: Natural) return Natural is diff --git a/disp_vhdl.adb b/disp_vhdl.adb index 1976f0324..982977ff3 100644 --- a/disp_vhdl.adb +++ b/disp_vhdl.adb @@ -669,10 +669,11 @@ package body Disp_Vhdl is end case; end Disp_Signal_Kind; - procedure Disp_Interface_Declaration (Interface: Iir) is + procedure Disp_Interface_Declaration (Inter: Iir) + is Default: Iir; begin - case Get_Kind (Interface) is + case Get_Kind (Inter) is when Iir_Kind_Signal_Interface_Declaration => Put ("signal "); when Iir_Kind_Variable_Interface_Declaration => @@ -680,16 +681,16 @@ package body Disp_Vhdl is when Iir_Kind_Constant_Interface_Declaration => Put ("constant "); when others => - Error_Kind ("disp_interface_declaration", Interface); + Error_Kind ("disp_interface_declaration", Inter); end case; - Disp_Name_Of (Interface); + Disp_Name_Of (Inter); Put (": "); - Disp_Mode (Get_Mode (Interface)); - Disp_Type (Get_Type (Interface)); - if Get_Kind (Interface) = Iir_Kind_Signal_Interface_Declaration then - Disp_Signal_Kind (Get_Signal_Kind (Interface)); + Disp_Mode (Get_Mode (Inter)); + Disp_Type (Get_Type (Inter)); + if Get_Kind (Inter) = Iir_Kind_Signal_Interface_Declaration then + Disp_Signal_Kind (Get_Signal_Kind (Inter)); end if; - Default := Get_Default_Value (Interface); + Default := Get_Default_Value (Inter); if Default /= Null_Iir then Put (" := "); Disp_Expression (Default); @@ -698,7 +699,7 @@ package body Disp_Vhdl is procedure Disp_Interface_Chain (Chain: Iir; Str: String) is - Interface: Iir; + Inter: Iir; Start: Count; begin if Chain = Null_Iir then @@ -706,17 +707,17 @@ package body Disp_Vhdl is end if; Put (" ("); Start := Col; - Interface := Chain; - while Interface /= Null_Iir loop + Inter := Chain; + while Inter /= Null_Iir loop Set_Col (Start); - Disp_Interface_Declaration (Interface); - if Get_Chain (Interface) /= Null_Iir then + Disp_Interface_Declaration (Inter); + if Get_Chain (Inter) /= Null_Iir then Put ("; "); else Put (')'); Put (Str); end if; - Interface := Get_Chain (Interface); + Inter := Get_Chain (Inter); end loop; end Disp_Interface_Chain; diff --git a/doc/ghdl.texi b/doc/ghdl.texi index 4824cdf84..41785e505 100644 --- a/doc/ghdl.texi +++ b/doc/ghdl.texi @@ -1522,13 +1522,21 @@ Do not simulate, only elaborate. This may be used with design. @item --vcd=@var{FILENAME} +@item --vcdgz=@var{FILENAME} @cindex @option{--vcd} option +@cindex @option{--vcdgz} option @cindex vcd @cindex value change dump @cindex dump of signals -Dump into the VCD file @var{FILENAME} the signal values before each -non-delta cycle. If @var{FILENAME} is @samp{-}, then the standard output is -used, otherwise a file is created or overwritten. +@option{--vcd} dumps into the VCD file @var{FILENAME} the signal +values before each non-delta cycle. If @var{FILENAME} is @samp{-}, +then the standard output is used, otherwise a file is created or +overwritten. + +The @option{--vcdgz} option is the same as the @option{--vcd} option, +but the output is compressed using the @code{zlib} (@code{gzip} +compression). However, you can't use the @samp{-} filename. +Furthermore, only one VCD file can be written. @dfn{VCD} (value change dump) is a file format defined by the @code{verilog} standard and used by virtually any wave viewer. diff --git a/evaluation.adb b/evaluation.adb index c64eea451..85df7c3bc 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -1171,6 +1171,34 @@ package body Evaluation is Natural (Get_Value (Get_Parameter (Attr)) - 1)); end Eval_Array_Attribute; + function Eval_Integer_Image (Val : Iir_Int64; Orig : Iir) return Iir + is + use Str_Table; + Img : String (1 .. 24); -- 23 is enough, 24 is rounded. + L : Natural; + V : Iir_Int64; + Id : String_Id; + begin + V := Val; + L := Img'Last; + loop + Img (L) := Character'Val (Character'Pos ('0') + abs (V rem 10)); + V := V / 10; + L := L - 1; + exit when V = 0; + end loop; + if Val < 0 then + Img (L) := '-'; + L := L - 1; + end if; + Id := Start; + for I in L + 1 .. Img'Last loop + Append (Img (I)); + end loop; + Finish; + return Build_String (Id, Int32 (Img'Last - L), Orig); + end Eval_Integer_Image; + function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir is P : Iir_Int64; @@ -1430,6 +1458,22 @@ package body Evaluation is return Build_Discrete (Val, Expr); end if; end; + when Iir_Kind_Image_Attribute => + declare + Param : Iir; + Param_Type : Iir; + begin + Param := Get_Parameter (Expr); + Param := Eval_Static_Expr (Param); + Set_Parameter (Expr, Param); + Param_Type := Get_Base_Type (Get_Type (Param)); + case Get_Kind (Param_Type) is + when Iir_Kind_Integer_Type_Definition => + return Eval_Integer_Image (Get_Value (Param), Expr); + when others => + Error_Kind ("eval_static_expr('image)", Param_Type); + end case; + end; when Iir_Kind_Left_Type_Attribute => return Build_Constant diff --git a/ortho/gcc/Makefile b/ortho/gcc/Makefile new file mode 100644 index 000000000..69c99969d --- /dev/null +++ b/ortho/gcc/Makefile @@ -0,0 +1,32 @@ +ortho_srcdir=.. +orthobe_srcdir=$(ortho_srcdir)/gcc +agcc_objdir=. +agcc_srcdir=$(ortho_srcdir)/gcc +AGCC_GCCSRC_DIR:=$(HOME)/dist/gcc-4.0.1 +AGCC_GCCOBJ_DIR:=$(AGCC_GCCSRC_DIR)-objs +SED=sed + +all: $(ortho_exec) + +include $(orthobe_srcdir)/Makefile.inc + +ORTHO_BASENAME=$(orthobe_srcdir)/ortho_gcc +ORTHO_PACKAGE=Ortho_Gcc + + +$(ortho_exec): $(AGCC_DEPS) $(ORTHO_BASENAME).ads force + gnatmake -m -o $@ -g -aI$(ortho_srcdir) \ + -aI$(ortho_srcdir)/gcc $(GNAT_FLAGS) ortho_gcc-main \ + -bargs -E -largs $(AGCC_OBJS) #-static + +clean: agcc-clean + $(RM) -f *.o *.ali ortho_nodes-main + $(RM) b~*.ad? *~ + +distclean: clean agcc-clean + + +force: + +.PHONY: force all clean + diff --git a/ortho/gcc/Makefile.inc b/ortho/gcc/Makefile.inc new file mode 100644 index 000000000..33ac0f428 --- /dev/null +++ b/ortho/gcc/Makefile.inc @@ -0,0 +1,62 @@ +# -*- Makefile -*- for the gcc implemantation of ortho. +# 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. + +# Variable used: +# AGCC_GCCSRC_DIR: the gcc source base directory (ie gcc-X.Y.Z-objs/) +# AGCC_GCCOBJ_DIR: the gcc objects base directory +# agcc_srcdir: the agcc source directory +# agcc_objdir: the agcc object directory + +AGCC_INC_FLAGS=-I$(AGCC_GCCOBJ_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/include \ + -I$(AGCC_GCCSRC_DIR)/gcc -I$(AGCC_GCCSRC_DIR)/gcc/config \ + -I$(AGCC_GCCSRC_DIR)/libcpp/include +AGCC_CFLAGS=-g -DIN_GCC $(AGCC_INC_FLAGS) + +AGCC_LOCAL_OBJS=ortho-lang.o gcc-version.o + +AGCC_DEPS := $(AGCC_LOCAL_OBJS) +AGCC_OBJS := $(AGCC_LOCAL_OBJS) \ + $(AGCC_GCCOBJ_DIR)/gcc/toplev.o \ + $(AGCC_GCCOBJ_DIR)/gcc/c-convert.o \ + $(AGCC_GCCOBJ_DIR)/gcc/libbackend.a \ + $(AGCC_GCCOBJ_DIR)/libcpp/libcpp.a \ + $(AGCC_GCCOBJ_DIR)/libiberty/libiberty.a + +gcc-version.c: $(AGCC_GCCSRC_DIR)/gcc/version.c + -$(RM) -f $@ + echo '#include "version.h"' > $@ + sed -n -e '/version_string/ s/";/ (ghdl)";/p' < $< >> $@ + echo 'const char bug_report_url[] = "";' >> $@ + +gcc-version.o: gcc-version.c + $(CC) -c -o $@ $< $(AGCC_CFLAGS) + +ortho-lang.o: $(agcc_srcdir)/ortho-lang.c \ + $(AGCC_GCCOBJ_DIR)/gcc/gtype-vhdl.h \ + $(AGCC_GCCOBJ_DIR)/gcc/gt-vhdl-ortho-lang.h + $(CC) -c -o $@ $< $(AGCC_CFLAGS) + +agcc-clean: force + $(RM) -f $(agcc_objdir)/*.o + $(RM) -f $(agcc_srcdir)/*~ + +agcc-maintainer-clean: force + $(RM) -f $(AGCC_DEPS) + + +.PHONY: agcc-clean agcc-maintainer-clean diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt new file mode 100644 index 000000000..2f945266b --- /dev/null +++ b/ortho/gcc/lang.opt @@ -0,0 +1,70 @@ +Language +vhdl + +-std= +vhdl Joined +Select the vhdl standard + +-compile-standard +vhdl +Used during compiler build to compile the std.standard package + +-bootstrap +vhdl +Used during compiler build to compile std packages + +-work= +vhdl Joined +Set the name of the work library + +-workdir= +vhdl Joined +Set the directory of the work library + +P +vhdl Joined +-P Add to the end of the vhdl library path + +-elab +vhdl Separate +--elab Used internally during elaboration of + +-anaelab +vhdl Separate +--anaelab Used internally during elaboration of + +c +vhdl Separate +-c Analyze for --anaelab + +v +vhdl +Verbose + +-warn- +vhdl Joined +--warn- Warn about + +-ghdl +vhdl Joined +--ghdl-