diff options
| author | gingold | 2008-08-30 13:30:19 +0000 |
|---|---|---|
| committer | gingold | 2008-08-30 13:30:19 +0000 |
| commit | cd9300765e7e3fd43e450777e98a778146f700c2 (patch) | |
| tree | f013fea17ae4eee9c1649e63b99b9bfe377fafb4 /translate/grt | |
| parent | 4b6571671497ecc1f846bfa49678254e14511fc9 (diff) | |
| download | ghdl-cd9300765e7e3fd43e450777e98a778146f700c2.tar.gz ghdl-cd9300765e7e3fd43e450777e98a778146f700c2.tar.bz2 ghdl-cd9300765e7e3fd43e450777e98a778146f700c2.zip | |
Switch to gcc 4.3
Don't use tagged types in grt (not supported by recent versions of GNAT)
Fix warnings
Diffstat (limited to 'translate/grt')
40 files changed, 453 insertions, 247 deletions
diff --git a/translate/grt/Makefile b/translate/grt/Makefile index ff68bc7..1c6af4d 100644 --- a/translate/grt/Makefile +++ b/translate/grt/Makefile @@ -18,7 +18,7 @@ GRT_FLAGS=-g -O GRT_ADAFLAGS=-gnatn -ADAC=gnatgcc +ADAC=gcc GNATFLAGS=$(CFLAGS) -gnatf -gnaty3befhkmr -gnatwlu GHDL1=../ghdl1-gcc GRTSRCDIR=. diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index b82e33b..3fc7361 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -33,7 +33,8 @@ # manufacturer, and operating system and assign each of those to its own # variable. -targ:=$(subst -, ,$(target)) +target1:=$(subst -gnu,,$(target)) +targ:=$(subst -, ,$(target1)) arch:=$(word 1,$(targ)) ifeq ($(words $(targ)),2) osys:=$(word 2,$(targ)) @@ -113,10 +114,15 @@ libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files # grt-arch.ads $(GRT_RANLIB) $@ run-bind.adb: grt-force - gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) ghdl_main \ - $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS) + gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) \ + ghdl_main $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS) gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali +#system.ads: +# sed -e "/Configurable_Run_Time/s/False/True/" \ +# -e "/Suppress_Standard_Library/s/False/True/" \ +# < `$(ADAC) -print-file-name=adainclude/system.ads` > $@ + run-bind.o: run-bind.adb $(GRT_ADACOMPILE) diff --git a/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb index ee264cf..b34744f 100644 --- a/translate/grt/grt-astdio.adb +++ b/translate/grt/grt-astdio.adb @@ -21,6 +21,7 @@ package body Grt.Astdio is procedure Put (Stream : FILEs; Str : String) is S : size_t; + pragma Unreferenced (S); begin S := fwrite (Str'Address, Str'Length, 1, Stream); end Put; @@ -28,6 +29,7 @@ package body Grt.Astdio is procedure Put (Stream : FILEs; C : Character) is R : int; + pragma Unreferenced (R); begin R := fputc (Character'Pos (C), Stream); end Put; @@ -36,6 +38,7 @@ package body Grt.Astdio is is Len : Natural; S : size_t; + pragma Unreferenced (S); begin Len := strlen (Str); S := fwrite (Str (1)'Address, size_t (Len), 1, Stream); @@ -49,6 +52,7 @@ package body Grt.Astdio is procedure Put (Str : String) is S : size_t; + pragma Unreferenced (S); begin S := fwrite (Str'Address, Str'Length, 1, stdout); end Put; @@ -56,6 +60,7 @@ package body Grt.Astdio is procedure Put (C : Character) is R : int; + pragma Unreferenced (R); begin R := fputc (Character'Pos (C), stdout); end Put; @@ -64,6 +69,7 @@ package body Grt.Astdio is is Len : Natural; S : size_t; + pragma Unreferenced (S); begin Len := strlen (Str); S := fwrite (Str (1)'Address, size_t (Len), 1, stdout); diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb index 36826fe..a5c36e5 100644 --- a/translate/grt/grt-avhpi.adb +++ b/translate/grt/grt-avhpi.adb @@ -126,9 +126,9 @@ package body Grt.Avhpi is case Res.N_Type.Kind is when Ghdl_Rtik_Subtype_Array => declare - St : Ghdl_Rtin_Subtype_Array_Acc := + St : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Res.N_Type); - Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype; + Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype; Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); begin Bound_To_Range @@ -155,6 +155,7 @@ package body Grt.Avhpi is El_Type : Ghdl_Rti_Access; Off : Ghdl_Index_Type) return Address is + pragma Unreferenced (Ctxt); Is_Sig : Boolean; El_Size : Ghdl_Index_Type; El_Type1 : Ghdl_Rti_Access; @@ -389,7 +390,6 @@ package body Grt.Avhpi is is Blk : Ghdl_Rtin_Block_Acc; Ch : Ghdl_Rti_Access; - Obj : Ghdl_Rtin_Object_Acc; begin Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block); @@ -420,7 +420,6 @@ package body Grt.Avhpi is exit when Iterator.It_Cur >= Blk.Nbr_Child; Ch := Blk.Children (Iterator.It_Cur); - Obj := To_Ghdl_Rtin_Object_Acc (Ch); Iterator.It_Cur := Iterator.It_Cur + 1; @@ -874,11 +873,12 @@ package body Grt.Avhpi is when VhpiSubtypeIndicK => if Ref.Atype.Kind = Ghdl_Rtik_Subtype_Array then declare - Arr_Subtype : Ghdl_Rtin_Subtype_Array_Acc := + Arr_Subtype : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Ref.Atype); - Basetype : Ghdl_Rtin_Type_Array_Acc := + Basetype : constant Ghdl_Rtin_Type_Array_Acc := Arr_Subtype.Basetype; - Idx : Ghdl_Index_Type := Ghdl_Index_Type (Index); + Idx : constant Ghdl_Index_Type := + Ghdl_Index_Type (Index); Bounds : Ghdl_Range_Array (0 .. Basetype.Nbr_Dim - 1); Range_Basetype : Ghdl_Rti_Access; begin @@ -961,6 +961,7 @@ package body Grt.Avhpi is case Property is when VhpiLeftBoundP => if Obj.Kind /= VhpiIntRangeK then + Res := 0; Error := AvhpiErrorBadRel; return; end if; @@ -999,6 +1000,7 @@ package body Grt.Avhpi is case Property is when VhpiIsUpP => if Obj.Kind /= VhpiIntRangeK then + Res := False; Error := AvhpiErrorBadRel; return; end if; diff --git a/translate/grt/grt-c.ads b/translate/grt/grt-c.ads index 33fb36c..6750e7d 100644 --- a/translate/grt/grt-c.ads +++ b/translate/grt/grt-c.ads @@ -33,4 +33,15 @@ package Grt.C is -- Type int. It is an alias on Integer for simplicity. subtype int is Integer; + + -- Low level memory management. + procedure Free (Addr : System.Address); + function Malloc (Size : size_t) return System.Address; + function Realloc (Ptr : System.Address; Size : size_t) + return System.Address; + +private + pragma Import (C, Free); + pragma Import (C, Malloc); + pragma Import (C, Realloc); end Grt.C; diff --git a/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb index 075c8b4..3a6b3e7 100644 --- a/translate/grt/grt-disp.adb +++ b/translate/grt/grt-disp.adb @@ -16,8 +16,7 @@ -- 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; +pragma Unreferenced (System.Storage_Elements); with Grt.Astdio; use Grt.Astdio; with Grt.Stdio; use Grt.Stdio; --with Grt.Errors; use Grt.Errors; diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb index dded644..c926775 100644 --- a/translate/grt/grt-disp_rti.adb +++ b/translate/grt/grt-disp_rti.adb @@ -17,7 +17,6 @@ -- 02111-1307, USA. with Grt.Astdio; use Grt.Astdio; with Grt.Errors; use Grt.Errors; -with Grt.Rtis_Addr; use Grt.Rtis_Addr; with Grt.Hooks; use Grt.Hooks; package body Grt.Disp_Rti is @@ -153,7 +152,7 @@ package body Grt.Disp_Rti is Vals : Ghdl_Uc_Array_Acc; Is_Sig : Boolean) is - Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim; + Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim; Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1); Obj : Address; begin @@ -166,7 +165,7 @@ package body Grt.Disp_Rti is procedure Disp_Record_Value (Stream : FILEs; Rti : Ghdl_Rtin_Type_Record_Acc; Ctxt : Rti_Context; - Obj : in out Address; + Obj : Address; Is_Sig : Boolean) is El : Ghdl_Rtin_Element_Acc; @@ -214,9 +213,9 @@ package body Grt.Disp_Rti is To_Ghdl_Uc_Array_Acc (Obj), Is_Sig); when Ghdl_Rtik_Subtype_Array => declare - St : Ghdl_Rtin_Subtype_Array_Acc := + St : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Rti); - Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype; + Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype; Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); B : Address; begin @@ -228,9 +227,9 @@ package body Grt.Disp_Rti is end; when Ghdl_Rtik_Subtype_Array_Ptr => declare - St : Ghdl_Rtin_Subtype_Array_Acc := + St : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Rti); - Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype; + Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype; Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); B : Address; begin diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb index e9011c9..85acb93 100644 --- a/translate/grt/grt-disp_signals.adb +++ b/translate/grt/grt-disp_signals.adb @@ -17,18 +17,15 @@ -- 02111-1307, USA. with System; use System; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Ada.Unchecked_Conversion; -with Grt.Types; use Grt.Types; with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Addr; use Grt.Rtis_Addr; with Grt.Rtis_Utils; use Grt.Rtis_Utils; -with Grt.Rtis; use Grt.Rtis; with Grt.Astdio; use Grt.Astdio; with Grt.Errors; use Grt.Errors; pragma Elaborate_All (Grt.Rtis_Utils); with Grt.Vstrings; use Grt.Vstrings; -with Grt.Stdio; use Grt.Stdio; -with Grt.Signals; use Grt.Signals; with Grt.Options; with Grt.Disp; use Grt.Disp; @@ -231,6 +228,7 @@ package body Grt.Disp_Signals is procedure Disp_All_Signals is Res : Traverse_Result; + pragma Unreferenced (Res); begin if Boolean'(False) then for I in Sig_Table.First .. Sig_Table.Last loop @@ -308,6 +306,7 @@ package body Grt.Disp_Signals is procedure Disp_Signals_Map is Res : Traverse_Result; + pragma Unreferenced (Res); begin Res := Disp_Signals_Map_Blocks (Get_Top_Context); Grt.Stdio.fflush (stdout); @@ -351,7 +350,6 @@ package body Grt.Disp_Signals is procedure Disp_Signals_Table is - use Grt.Disp; Sig : Ghdl_Signal_Ptr; begin for I in Sig_Table.First .. Sig_Table.Last loop @@ -458,6 +456,7 @@ package body Grt.Disp_Signals is (Process_Block); Res_Status : Traverse_Result; + pragma Unreferenced (Res_Status); begin Res_Status := Foreach_Block (Get_Top_Context); if not Found then diff --git a/translate/grt/grt-disp_tree.adb b/translate/grt/grt-disp_tree.adb index e4f55f3..3f337ab 100644 --- a/translate/grt/grt-disp_tree.adb +++ b/translate/grt/grt-disp_tree.adb @@ -83,7 +83,8 @@ package body Grt.Disp_Tree is | Ghdl_Rtik_Block | Ghdl_Rtik_If_Generate => declare - Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti); + Blk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Rti); begin Disp_Name (Blk.Name); end; @@ -104,7 +105,8 @@ package body Grt.Disp_Tree is end; when Ghdl_Rtik_For_Generate => declare - Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti); + Blk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Rti); Iter : Ghdl_Rtin_Object_Acc; Addr : Address; begin @@ -231,7 +233,8 @@ package body Grt.Disp_Tree is when Ghdl_Rtik_Process | Ghdl_Rtik_Block => declare - Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child); + Nblk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Child); Nctxt : Rti_Context; begin Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off, @@ -241,7 +244,8 @@ package body Grt.Disp_Tree is end; when Ghdl_Rtik_For_Generate => declare - Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child); + Nblk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Child); Nctxt : Rti_Context; Length : Ghdl_Index_Type; Old_Child2 : Ghdl_Rti_Access; @@ -268,7 +272,8 @@ package body Grt.Disp_Tree is end; when Ghdl_Rtik_If_Generate => declare - Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child); + Nblk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Child); Nctxt : Rti_Context; begin Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all, @@ -402,8 +407,9 @@ package body Grt.Disp_Tree is end loop; end Disp_Hierarchy; - function Disp_Tree_Option (Opt : String) return Boolean + function Disp_Tree_Option (Option : String) return Boolean is + Opt : constant String (1 .. Option'Length) := Option; begin if Opt'Length >= 11 and then Opt (1 .. 11) = "--disp-tree" then if Opt'Length = 11 then diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb index 6273161..5b541af 100644 --- a/translate/grt/grt-errors.adb +++ b/translate/grt/grt-errors.adb @@ -17,7 +17,6 @@ -- 02111-1307, USA. with Grt.Stdio; use Grt.Stdio; with Grt.Astdio; use Grt.Astdio; -with Grt.Types; use Grt.Types; with Grt.Options; use Grt.Options; package body Grt.Errors is @@ -106,7 +105,7 @@ package body Grt.Errors is procedure Report_C (Str : Ghdl_C_String) is - Len : Natural := strlen (Str); + Len : constant Natural := strlen (Str); begin Put_Err (Str (1 .. Len)); end Report_C; @@ -154,7 +153,7 @@ package body Grt.Errors is procedure Error_C (Str : Ghdl_C_String) is - Len : Natural := strlen (Str); + Len : constant Natural := strlen (Str); begin if not Cont then Error_H; diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb index 6da675d..a1ce0ce 100644 --- a/translate/grt/grt-files.adb +++ b/translate/grt/grt-files.adb @@ -18,8 +18,9 @@ with Grt.Errors; use Grt.Errors; with Grt.Stdio; use Grt.Stdio; with Grt.C; use Grt.C; -with GNAT.Table; +with Grt.Table; with System; use System; +pragma Elaborate_All (Grt.Table); package body Grt.Files is subtype C_Files is Grt.Stdio.FILEs; @@ -31,12 +32,11 @@ package body Grt.Files is Is_Alive : Boolean; end record; - package Files_Table is new GNAT.Table + package Files_Table is new Grt.Table (Table_Component_Type => File_Entry_Type, Table_Index_Type => Ghdl_File_Index, Table_Low_Bound => 1, - Table_Initial => 2, - Table_Increment => 100); + Table_Initial => 2); function Get_File (Index : Ghdl_File_Index) return C_Files is @@ -56,17 +56,13 @@ package body Grt.Files is end Check_File_Mode; function Create_File (Is_Text : Boolean; Sig : Ghdl_C_String) - return Ghdl_File_Index - is - Res : Ghdl_File_Index; + return Ghdl_File_Index is begin - Files_Table.Increment_Last; - Res := Files_Table.Last; - Files_Table.Table (Res) := (Stream => NULL_Stream, - Signature => Sig, - Is_Text => Is_Text, - Is_Alive => True); - return Res; + Files_Table.Append ((Stream => NULL_Stream, + Signature => Sig, + Is_Text => Is_Text, + Is_Alive => True)); + return Files_Table.Last; end Create_File; procedure Destroy_File (Is_Text : Boolean; Index : Ghdl_File_Index) is @@ -289,6 +285,7 @@ package body Grt.Files is Res : C_Files; R : size_t; R1 : int; + pragma Unreferenced (R, R1); begin Res := Get_File (File); Check_File_Mode (File, True); @@ -311,6 +308,7 @@ package body Grt.Files is Res : C_Files; R : size_t; R1 : int; + pragma Unreferenced (R1); begin Res := Get_File (File); Check_File_Mode (File, False); diff --git a/translate/grt/grt-files.ads b/translate/grt/grt-files.ads index 1fcce3c..b874780 100644 --- a/translate/grt/grt-files.ads +++ b/translate/grt/grt-files.ads @@ -83,7 +83,7 @@ package Grt.Files is procedure Ghdl_Text_File_Close (File : Ghdl_File_Index); procedure Ghdl_File_Close (File : Ghdl_File_Index); private - pragma Export (C, Ghdl_File_Endfile, "__ghdl_file_endfile"); + pragma Export (Ada, Ghdl_File_Endfile, "__ghdl_file_endfile"); pragma Export (C, Ghdl_Text_File_Elaborate, "__ghdl_text_file_elaborate"); pragma Export (C, Ghdl_File_Elaborate, "__ghdl_file_elaborate"); diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb index 5f8a081..d6efba0 100644 --- a/translate/grt/grt-images.adb +++ b/translate/grt/grt-images.adb @@ -17,6 +17,7 @@ -- 02111-1307, USA. with System; use System; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Ada.Unchecked_Conversion; with Grt.Processes; use Grt.Processes; with Grt.Vstrings; use Grt.Vstrings; @@ -98,7 +99,7 @@ package body Grt.Images is Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name; Unit_Len := strlen (Unit); declare - L : Natural := Str'Last + 1 - First; + L : constant Natural := Str'Last + 1 - First; Str2 : String (1 .. L + 1 + Unit_Len); begin Str2 (1 .. L) := Str (First .. Str'Last); @@ -122,7 +123,7 @@ package body Grt.Images is Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name; Unit_Len := strlen (Unit); declare - L : Natural := Str'Last + 1 - First; + L : constant Natural := Str'Last + 1 - First; Str2 : String (1 .. L + 1 + Unit_Len); begin Str2 (1 .. L) := Str (First .. Str'Last); diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads index 74a7bd7..0d7224b 100644 --- a/translate/grt/grt-images.ads +++ b/translate/grt/grt-images.ads @@ -32,7 +32,7 @@ package Grt.Images is procedure Ghdl_Image_P32 (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access); private - pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2"); + pragma Export (Ada, Ghdl_Image_B2, "__ghdl_image_b2"); pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8"); pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32"); pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32"); diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb index 0d1507f..dcddcf2 100644 --- a/translate/grt/grt-lib.adb +++ b/translate/grt/grt-lib.adb @@ -41,7 +41,7 @@ package body Grt.Lib is Unit : Ghdl_Rti_Access) is use Grt.Options; - Level : Integer := Severity mod 256; + Level : constant Integer := Severity mod 256; begin -- Assertions from ieee library can be disabled. if Unit /= null @@ -51,9 +51,11 @@ package body Grt.Lib is and Current_Time = 0)) then declare - Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Unit); - Pkg : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Blk.Parent); - Lib : Ghdl_Rtin_Type_Scalar_Acc := + Blk : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Unit); + Pkg : constant Ghdl_Rtin_Block_Acc := + To_Ghdl_Rtin_Block_Acc (Blk.Parent); + Lib : constant Ghdl_Rtin_Type_Scalar_Acc := To_Ghdl_Rtin_Type_Scalar_Acc (Pkg.Parent); begin -- Return now if this assert comes from the ieee library. diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb index 86a388c..43166fa 100644 --- a/translate/grt/grt-main.adb +++ b/translate/grt/grt-main.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Types; use Grt.Types; with Grt.Errors; with Grt.Stacks; @@ -60,6 +61,9 @@ package body Grt.Main is is Err : Boolean; begin + -- The conditions may be statically known. + pragma Warnings (Off); + Err := False; if (Std_Integer'Size = 32 and Flag_String (3) /= 'i') or else (Std_Integer'Size = 64 and Flag_String (3) /= 'I') @@ -71,6 +75,9 @@ package body Grt.Main is then Err := True; end if; + + pragma Warnings (On); + if Err then Grt.Errors.Error ("GRT is not consistent with the flags used for your design"); diff --git a/translate/grt/grt-modules.adb b/translate/grt/grt-modules.adb index 6fe8eea..cb43711 100644 --- a/translate/grt/grt-modules.adb +++ b/translate/grt/grt-modules.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Vcd; with Grt.Vcdz; with Grt.Vpi; diff --git a/translate/grt/grt-names.adb b/translate/grt/grt-names.adb index 46ed04e..8afe1bc 100644 --- a/translate/grt/grt-names.adb +++ b/translate/grt/grt-names.adb @@ -18,6 +18,7 @@ --with Grt.Errors; use Grt.Errors; with Ada.Unchecked_Conversion; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); 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-options.adb b/translate/grt/grt-options.adb index 0cb515e..a272246 100644 --- a/translate/grt/grt-options.adb +++ b/translate/grt/grt-options.adb @@ -253,7 +253,7 @@ package body Grt.Options is Arg := Argv (I); Len := strlen (Arg); declare - Argument : String := Arg (1 .. Len); + Argument : constant String := Arg (1 .. Len); begin if Argument = "--" then Last_Opt := I; diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb index 650c0f0..058e8a5 100644 --- a/translate/grt/grt-processes.adb +++ b/translate/grt/grt-processes.adb @@ -15,14 +15,13 @@ -- 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 GNAT.Table; +with Grt.Table; with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with System.Storage_Elements; -- Work around GNAT bug. -with Grt.Stack2; use Grt.Stack2; +pragma Unreferenced (System.Storage_Elements); with Grt.Disp; with Grt.Astdio; -with Grt.Signals; use Grt.Signals; with Grt.Errors; use Grt.Errors; with Grt.Stacks; use Grt.Stacks; with Grt.Options; @@ -30,28 +29,26 @@ with Grt.Rtis_Addr; use Grt.Rtis_Addr; with Grt.Rtis_Utils; with Grt.Hooks; with Grt.Disp_Signals; -with Grt.Stdio; with Grt.Stats; with Grt.Threads; use Grt.Threads; +pragma Elaborate_All (Grt.Table); package body Grt.Processes is Last_Time : constant Std_Time := Std_Time'Last; -- Table of processes. - package Process_Table is new GNAT.Table + package Process_Table is new Grt.Table (Table_Component_Type => Process_Type, Table_Index_Type => Process_Id, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); -- List of non_sensitized processes. - package Non_Sensitized_Process_Table is new GNAT.Table + package Non_Sensitized_Process_Table is new Grt.Table (Table_Component_Type => Process_Id, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 2, - Table_Increment => 100); + Table_Initial => 2); -- List of processes to be resume at next cycle. type Process_Id_Array is array (Natural range <>) of Process_Id; @@ -74,7 +71,7 @@ package body Grt.Processes is procedure Init is begin - Process_Table.Init; + null; end Init; function Get_Nbr_Processes return Natural is @@ -380,7 +377,7 @@ package body Grt.Processes is procedure Ghdl_Protected_Enter (Obj : System.Address) is - Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all; + Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all; begin if Lock.Process = Nul_Process_Id then if Lock.Count /= 0 then @@ -398,13 +395,13 @@ package body Grt.Processes is procedure Ghdl_Protected_Leave (Obj : System.Address) is - Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all; + Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all; begin if Lock.Process /= Get_Current_Process_Id then Internal_Error ("protected_leave(1)"); end if; - if Lock.Count <= 0 then + if Lock.Count = 0 then Internal_Error ("protected_leave(2)"); end if; Lock.Count := Lock.Count - 1; @@ -415,7 +412,7 @@ package body Grt.Processes is procedure Ghdl_Protected_Init (Obj : System.Address) is - Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj); + Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj); begin Lock.all := new Object_Lock'(Process => Nul_Process_Id, Count => 0); @@ -426,7 +423,7 @@ package body Grt.Processes is procedure Deallocate is new Ada.Unchecked_Deallocation (Object => Object_Lock, Name => Object_Lock_Acc); - Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj); + Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj); begin if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id then Internal_Error ("protected_fini"); @@ -455,7 +452,8 @@ package body Grt.Processes is Non_Sensitized_Process_Table.Last loop declare - Pid : Process_Id := Non_Sensitized_Process_Table.Table (I); + Pid : constant Process_Id := + Non_Sensitized_Process_Table.Table (I); Proc : Process_Type renames Process_Table.Table (Pid); begin if Proc.State = State_Wait @@ -488,7 +486,7 @@ package body Grt.Processes is -- pragma Convention (C, Run_Handler); function Run_Through_Longjump (Hand : Run_Handler) return Integer; - pragma Import (C, Run_Through_Longjump, "__ghdl_run_through_longjump"); + pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump"); -- Run resumed processes. -- If POSTPONED is true, resume postponed processes, else resume @@ -703,7 +701,8 @@ package body Grt.Processes is Non_Sensitized_Process_Table.Last loop declare - Pid : Process_Id := Non_Sensitized_Process_Table.Table (I); + Pid : constant Process_Id := + Non_Sensitized_Process_Table.Table (I); Proc : Process_Type renames Process_Table.Table (Pid); El : Sensitivity_Acc; begin diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads index 2ef0653..a3a2cf0 100644 --- a/translate/grt/grt-processes.ads +++ b/translate/grt/grt-processes.ads @@ -205,7 +205,7 @@ private "__ghdl_process_wait_add_sensitivity"); pragma Export (C, Ghdl_Process_Wait_Set_Timeout, "__ghdl_process_wait_set_timeout"); - pragma Export (C, Ghdl_Process_Wait_Suspend, + pragma Export (Ada, Ghdl_Process_Wait_Suspend, "__ghdl_process_wait_suspend"); pragma Export (C, Ghdl_Process_Wait_Close, "__ghdl_process_wait_close"); diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb index 84d7c3a..4488654 100644 --- a/translate/grt/grt-rtis_addr.adb +++ b/translate/grt/grt-rtis_addr.adb @@ -15,7 +15,6 @@ -- 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 Ada.Unchecked_Conversion; with Grt.Errors; use Grt.Errors; package body Grt.Rtis_Addr is diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb index 4fd558e..18a5dfe 100644 --- a/translate/grt/grt-rtis_utils.adb +++ b/translate/grt/grt-rtis_utils.adb @@ -15,9 +15,6 @@ -- 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.Rtis; use Grt.Rtis; -with Grt.Types; use Grt.Types; --with Grt.Disp; use Grt.Disp; with Grt.Errors; use Grt.Errors; @@ -318,7 +315,7 @@ package body Grt.Rtis_Utils is procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc; Vals : Ghdl_Uc_Array_Acc) is - Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim; + Nbr_Dim : constant Ghdl_Index_Type := Rti.Nbr_Dim; Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1); begin Bound_To_Range (Vals.Bounds, Rti, Rngs); @@ -367,9 +364,9 @@ package body Grt.Rtis_Utils is To_Ghdl_Uc_Array_Acc (Addr)); when Ghdl_Rtik_Subtype_Array => declare - St : Ghdl_Rtin_Subtype_Array_Acc := + St : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Rti); - Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype; + Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype; Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); begin Bound_To_Range @@ -385,9 +382,9 @@ package body Grt.Rtis_Utils is end; when Ghdl_Rtik_Subtype_Array_Ptr => declare - St : Ghdl_Rtin_Subtype_Array_Acc := + St : constant Ghdl_Rtin_Subtype_Array_Acc := To_Ghdl_Rtin_Subtype_Array_Acc (Rti); - Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype; + Bt : constant Ghdl_Rtin_Type_Array_Acc := St.Basetype; Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1); begin Bound_To_Range @@ -521,7 +518,7 @@ package body Grt.Rtis_Utils is Addr : Address; Type_Rti : Ghdl_Rti_Access) is - Value : Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr); + Value : constant Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr); begin case Type_Rti.Kind is when Ghdl_Rtik_Type_I32 => diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb index b564017..fbf9f3e 100644 --- a/translate/grt/grt-sdf.adb +++ b/translate/grt/grt-sdf.adb @@ -16,7 +16,7 @@ -- 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; +pragma Unreferenced (System.Storage_Elements); with Grt.Stdio; use Grt.Stdio; with Grt.C; use Grt.C; with Grt.Errors; use Grt.Errors; diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index 77a453b..505b281 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -17,8 +17,8 @@ -- 02111-1307, USA. with System; use System; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Ada.Unchecked_Deallocation; -with Ada.Unchecked_Conversion; with Grt.Errors; use Grt.Errors; with Grt.Processes; use Grt.Processes; with Grt.Options; use Grt.Options; @@ -1750,7 +1750,8 @@ package body Grt.Signals is procedure Compute_Resolved_Signal (Resolv : Resolved_Signal_Acc) is - Sig : Ghdl_Signal_Ptr := Sig_Table.Table (Resolv.Sig_Range.First); + Sig : constant Ghdl_Signal_Ptr := + Sig_Table.Table (Resolv.Sig_Range.First); Length : Ghdl_Index_Type; type Bool_Array_Type is array (1 .. Sig.S.Nbr_Drivers) of Boolean; Vec : Bool_Array_Type; @@ -2135,7 +2136,7 @@ package body Grt.Signals is declare S : Ghdl_Signal_Ptr; - Old : Signal_Net_Type := Sig.Net; + Old : constant Signal_Net_Type := Sig.Net; begin -- Merge the old net into NET. S := Sig; diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index aca2744..d16e887 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -17,9 +17,10 @@ -- 02111-1307, USA. with System; with Ada.Unchecked_Conversion; -with GNAT.Table; +with Grt.Table; with Grt.Types; use Grt.Types; with Grt.Rtis; use Grt.Rtis; +pragma Elaborate_All (Grt.Table); package Grt.Signals is pragma Suppress (All_Checks); @@ -264,12 +265,11 @@ package Grt.Signals is end record; -- Each simple signal declared can be accessed by SIG_TABLE. - package Sig_Table is new GNAT.Table + package Sig_Table is new Grt.Table (Table_Component_Type => Ghdl_Signal_Ptr, Table_Index_Type => Sig_Table_Index, Table_Low_Bound => 0, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); -- Return the next time at which a driver becomes active. function Find_Next_Time return Std_Time; @@ -380,12 +380,11 @@ package Grt.Signals is end case; end record; - package Propagation is new GNAT.Table + package Propagation is new Grt.Table (Table_Component_Type => Propagation_Type, Table_Index_Type => Signal_Net_Type, Table_Low_Bound => 1, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); -- Get the signal index of PTR. function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index; @@ -660,22 +659,22 @@ private pragma Export (C, Ghdl_Signal_Disconnect, "__ghdl_signal_disconnect"); - pragma Export (C, Ghdl_Signal_Driving, + pragma Export (Ada, Ghdl_Signal_Driving, "__ghdl_signal_driving"); - pragma Export (C, Ghdl_Create_Signal_B2, + pragma Export (Ada, Ghdl_Create_Signal_B2, "__ghdl_create_signal_b2"); - pragma Export (C, Ghdl_Signal_Init_B2, + pragma Export (Ada, Ghdl_Signal_Init_B2, "__ghdl_signal_init_b2"); - pragma Export (C, Ghdl_Signal_Associate_B2, + pragma Export (Ada, Ghdl_Signal_Associate_B2, "__ghdl_signal_associate_b2"); - pragma Export (C, Ghdl_Signal_Simple_Assign_B2, + pragma Export (Ada, Ghdl_Signal_Simple_Assign_B2, "__ghdl_signal_simple_assign_b2"); - pragma Export (C, Ghdl_Signal_Start_Assign_B2, + pragma Export (Ada, Ghdl_Signal_Start_Assign_B2, "__ghdl_signal_start_assign_b2"); - pragma Export (C, Ghdl_Signal_Next_Assign_B2, + pragma Export (Ada, Ghdl_Signal_Next_Assign_B2, "__ghdl_signal_next_assign_b2"); - pragma Export (C, Ghdl_Signal_Driving_Value_B2, + pragma Export (Ada, Ghdl_Signal_Driving_Value_B2, "__ghdl_signal_driving_value_b2"); pragma Export (C, Ghdl_Create_Signal_E8, @@ -781,7 +780,7 @@ private pragma Export (C, Ghdl_Create_Delayed_Signal, "__ghdl_create_delayed_signal"); - pragma Export (C, Ghdl_Signal_Create_Guard, + pragma Export (Ada, Ghdl_Signal_Create_Guard, "__ghdl_signal_create_guard"); pragma Export (C, Ghdl_Signal_Guard_Dependence, "__ghdl_signal_guard_dependence"); diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb index 973d617..13a939a 100644 --- a/translate/grt/grt-stats.adb +++ b/translate/grt/grt-stats.adb @@ -17,6 +17,7 @@ -- 02111-1307, USA. with System; use System; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Stdio; use Grt.Stdio; with Grt.Astdio; use Grt.Astdio; with Grt.Signals; diff --git a/translate/grt/grt-table.adb b/translate/grt/grt-table.adb new file mode 100644 index 0000000..f570b40 --- /dev/null +++ b/translate/grt/grt-table.adb @@ -0,0 +1,113 @@ +-- GHDL Run Time (GRT) - Resizable array +-- Copyright (C) 2008 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 body Grt.Table is + + -- Maximum index of table before resizing. + Max : Table_Index_Type := Table_Low_Bound - 1; + + -- Current value of Last + Last_Val : Table_Index_Type; + + function Malloc (Size : size_t) return Table_Ptr; + pragma Import (C, Malloc); + + procedure Free (T : Table_Ptr); + pragma Import (C, Free); + + -- Resize and reallocate the table according to LAST_VAL. + procedure Resize is + function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr; + pragma Import (C, Realloc); + + New_Size : size_t; + begin + while Max < Last_Val loop + Max := Max + (Max - Table_Low_Bound + 1); + end loop; + + New_Size := size_t ((Max - Table_Low_Bound + 1) * + (Table_Type'Component_Size / Storage_Unit)); + + Table := Realloc (Table, New_Size); + + if Table = null then + raise Storage_Error; + end if; + end Resize; + + procedure Append (New_Val : Table_Component_Type) is + begin + Increment_Last; + Table (Last_Val) := New_Val; + end Append; + + procedure Decrement_Last is + begin + Last_Val := Last_Val - 1; + end Decrement_Last; + + procedure Free is + begin + Free (Table); + Table := null; + end Free; + + procedure Increment_Last is + begin + Last_Val := Last_Val + 1; + + if Last_Val > Max then + Resize; + end if; + end Increment_Last; + + function Last return Table_Index_Type is + begin + return Last_Val; + end Last; + + procedure Release is + begin + Max := Last_Val; + Resize; + end Release; + + procedure Set_Last (New_Val : Table_Index_Type) is + begin + if New_Val < Last_Val then + Last_Val := New_Val; + else + Last_Val := New_Val; + + if Last_Val > Max then + Resize; + end if; + end if; + end Set_Last; + +begin + Last_Val := Table_Low_Bound - 1; + Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1; + + Table := Malloc (size_t (Table_Initial * + (Table_Type'Component_Size / Storage_Unit))); +end Grt.Table; diff --git a/translate/grt/grt-table.ads b/translate/grt/grt-table.ads new file mode 100644 index 0000000..528d73b --- /dev/null +++ b/translate/grt/grt-table.ads @@ -0,0 +1,68 @@ +-- GHDL Run Time (GRT) - Resizable array +-- Copyright (C) 2008 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. + +generic + type Table_Component_Type is private; + type Table_Index_Type is range <>; + + Table_Low_Bound : Table_Index_Type; + Table_Initial : Positive; + +package Grt.Table is + pragma Elaborate_Body; + + type Table_Type is + array (Table_Index_Type range <>) of Table_Component_Type; + subtype Fat_Table_Type is + Table_Type (Table_Low_Bound .. Table_Index_Type'Last); + + -- Thin pointer. + type Table_Ptr is access all Fat_Table_Type; + + -- The table itself. + Table : aliased Table_Ptr := null; + + -- Get the high bound. + function Last return Table_Index_Type; + pragma Inline (Last); + + -- Get the low bound. + First : constant Table_Index_Type := Table_Low_Bound; + + -- Increase the length by 1. + procedure Increment_Last; + pragma Inline (Increment_Last); + + -- Decrease the length by 1. + procedure Decrement_Last; + pragma Inline (Decrement_Last); + + -- Set the last bound. + procedure Set_Last (New_Val : Table_Index_Type); + + -- Release extra memory. + procedure Release; + + -- Free all the memory used by the table. + -- The table won't be useable anymore. + procedure Free; + + -- Append a new element. + procedure Append (New_Val : Table_Component_Type); + pragma Inline (Append); +end Grt.Table; diff --git a/translate/grt/grt-unithread.adb b/translate/grt/grt-unithread.adb index 668e9b7..3197e2c 100644 --- a/translate/grt/grt-unithread.adb +++ b/translate/grt/grt-unithread.adb @@ -15,7 +15,6 @@ -- 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.Types; use Grt.Types; package body Grt.Unithread is procedure Init is diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads index 2f244e6..0f8f48a 100644 --- a/translate/grt/grt-unithread.ads +++ b/translate/grt/grt-unithread.ads @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Signals; use Grt.Signals; with Grt.Stack2; use Grt.Stack2; with Grt.Stacks; use Grt.Stacks; diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb index f7aa0d8..bf1842d 100644 --- a/translate/grt/grt-vcd.adb +++ b/translate/grt/grt-vcd.adb @@ -17,53 +17,48 @@ -- 02111-1307, USA. with Interfaces; with Grt.Stdio; use Grt.Stdio; -with System; use System; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Errors; use Grt.Errors; -with Grt.Types; use Grt.Types; with Grt.Signals; use Grt.Signals; -with GNAT.Table; +with Grt.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; +pragma Elaborate_All (Grt.Table); package body Grt.Vcd is -- If TRUE, put $date in vcd file. -- Can be set to FALSE to make vcd comparaison easier. Flag_Vcd_Date : Boolean := True; - 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); + Stream : FILEs; - procedure Vcd_Put (Handler : access Vcd_IO_Simple; Str : String) + procedure My_Vcd_Put (Str : String) is R : size_t; + pragma Unreferenced (R); begin - R := fwrite (Str'Address, Str'Length, 1, Handler.Stream); - end Vcd_Put; + R := fwrite (Str'Address, Str'Length, 1, Stream); + end My_Vcd_Put; - procedure Vcd_Putc (Handler : access Vcd_IO_Simple; C : Character) + procedure My_Vcd_Putc (C : Character) is R : int; + pragma Unreferenced (R); begin - R := fputc (Character'Pos (C), Handler.Stream); - end Vcd_Putc; + R := fputc (Character'Pos (C), Stream); + end My_Vcd_Putc; - procedure Vcd_Close (Handler : access Vcd_IO_Simple) is + procedure My_Vcd_Close is begin - fclose (Handler.Stream); - Handler.Stream := NULL_Stream; - end Vcd_Close; + fclose (Stream); + Stream := NULL_Stream; + end My_Vcd_Close; -- VCD filename. -- Stream corresponding to the VCD filename. @@ -75,9 +70,8 @@ package body Grt.Vcd is -- Return TRUE if OPT is an option for VCD. function Vcd_Option (Opt : String) return Boolean is - F : Natural := Opt'First; + F : constant 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 @@ -88,7 +82,7 @@ package body Grt.Vcd is return True; end if; if Opt'Length > 6 and then Opt (F + 5) = '=' then - if H /= null then + if Vcd_Close /= null then Error ("--vcd: file already set"); return True; end if; @@ -98,19 +92,20 @@ package body Grt.Vcd is 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; + Stream := stdout; else - Handler.Stream := fopen (Vcd_Filename.all'Address, Mode'Address); - if Handler.Stream = NULL_Stream then + Stream := fopen (Vcd_Filename.all'Address, Mode'Address); + if 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); + Vcd_Putc := My_Vcd_Putc'Access; + Vcd_Put := My_Vcd_Put'Access; + Vcd_Close := My_Vcd_Close'Access; return True; else return False; @@ -123,24 +118,14 @@ package body Grt.Vcd is Put_Line (" --vcd-nodate do not write date in VCD file"); end Vcd_Help; - procedure Vcd_Put (Str : String) is - begin - Vcd_Put (H, Str); - end Vcd_Put; - - procedure Vcd_Putc (C : Character) is - begin - Vcd_Putc (H, C); - end Vcd_Putc; - procedure Vcd_Newline is begin - Vcd_Putc (H, Nl); + Vcd_Putc (Nl); end Vcd_Newline; procedure Vcd_Putline (Str : String) is begin - Vcd_Put (H, Str); + Vcd_Put (Str); Vcd_Newline; end Vcd_Putline; @@ -200,7 +185,7 @@ package body Grt.Vcd is procedure Vcd_Init is begin - if H = null then + if Vcd_Close = null then return; end if; if Flag_Vcd_Date then @@ -236,12 +221,11 @@ package body Grt.Vcd is Vcd_Put_End; end Vcd_Init; - package Vcd_Table is new GNAT.Table + package Vcd_Table is new Grt.Table (Table_Component_Type => Verilog_Wire_Info, Table_Index_Type => Vcd_Index_Type, Table_Low_Bound => 0, - Table_Initial => 32, - Table_Increment => 100); + Table_Initial => 32); procedure Avhpi_Error (Err : AvhpiErrorT) is @@ -306,13 +290,10 @@ package body Grt.Vcd is procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info) is Sig_Type : VhpiHandleT; - Sig_Rti : Ghdl_Rtin_Object_Acc; Rti : Ghdl_Rti_Access; Error : AvhpiErrorT; Sig_Addr : Address; begin - Sig_Rti := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Sig)); - -- Extract type of the signal. Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error); if Error /= AvhpiErrorOk then @@ -711,7 +692,7 @@ package body Grt.Vcd is Root : VhpiHandleT; begin -- Do nothing if there is no VCD file to generate. - if H = null then + if Vcd_Close = null then return; end if; @@ -752,8 +733,8 @@ package body Grt.Vcd is -- Called at the end of the simulation. procedure Vcd_End is begin - if H /= null then - Vcd_Close (H); + if Vcd_Close /= null then + Vcd_Close.all; end if; end Vcd_End; diff --git a/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads index a6d79b4..1079e90 100644 --- a/translate/grt/grt-vcd.ads +++ b/translate/grt/grt-vcd.ads @@ -21,16 +21,13 @@ 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_Put_Acc is access procedure (Str : String); + type Vcd_Putc_Acc is access procedure (C : Character); + type Vcd_Close_Acc is access procedure; + + Vcd_Put : Vcd_Put_Acc; + Vcd_Putc : Vcd_Putc_Acc; + Vcd_Close : Vcd_Close_Acc; type Vcd_Var_Kind is (Vcd_Bad, Vcd_Bool, diff --git a/translate/grt/grt-vcdz.adb b/translate/grt/grt-vcdz.adb index a6ba718..aec35a8 100644 --- a/translate/grt/grt-vcdz.adb +++ b/translate/grt/grt-vcdz.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Vcd; use Grt.Vcd; with Grt.Errors; use Grt.Errors; with Grt.Types; use Grt.Types; @@ -25,49 +26,44 @@ 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); + Stream : gzFile; - procedure Vcd_Put (Handler : access Vcd_IO_Gzip; Str : String) + procedure My_Vcd_Put (Str : String) is R : int; + pragma Unreferenced (R); begin - R := gzwrite (Handler.Stream, Str'Address, Str'Length); - end Vcd_Put; + R := gzwrite (Stream, Str'Address, Str'Length); + end My_Vcd_Put; - procedure Vcd_Putc (Handler : access Vcd_IO_Gzip; C : Character) + procedure My_Vcd_Putc (C : Character) is R : int; + pragma Unreferenced (R); begin - R := gzputc (Handler.Stream, Character'Pos (C)); - end Vcd_Putc; + R := gzputc (Stream, Character'Pos (C)); + end My_Vcd_Putc; - procedure Vcd_Close (Handler : access Vcd_IO_Gzip) is + procedure My_Vcd_Close is begin - gzclose (Handler.Stream); - Handler.Stream := NULL_gzFile; - end Vcd_Close; + gzclose (Stream); + Stream := NULL_gzFile; + end My_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; + F : constant 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 + if Vcd_Close /= null then Error ("--vcdgz: file already set"); return True; end if; @@ -77,15 +73,16 @@ package body Grt.Vcdz is 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 + Stream := gzopen (Vcd_Filename.all'Address, Mode'Address); + if 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); + Vcd_Putc := My_Vcd_Putc'Access; + Vcd_Put := My_Vcd_Put'Access; + Vcd_Close := My_Vcd_Close'Access; return True; else return False; diff --git a/translate/grt/grt-vital_annotate.adb b/translate/grt/grt-vital_annotate.adb index 5c8c1d0..2e7987c 100644 --- a/translate/grt/grt-vital_annotate.adb +++ b/translate/grt/grt-vital_annotate.adb @@ -15,7 +15,6 @@ -- 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.Sdf; with Grt.Types; use Grt.Types; with Grt.Hooks; use Grt.Hooks; with Grt.Astdio; use Grt.Astdio; @@ -32,7 +31,7 @@ package body Grt.Vital_Annotate is Sdf_Inst : VhpiHandleT; Flag_Dump : Boolean := False; - Flag_Verbose : Boolean := False; + Flag_Verbose : constant Boolean := False; function Name_Compare (Handle : VhpiHandleT; Name : String; @@ -140,7 +139,7 @@ package body Grt.Vital_Annotate is end Find_Generic; - procedure Sdf_Header (Context : in out Sdf_Context_Type) + procedure Sdf_Header (Context : Sdf_Context_Type) is begin if Flag_Dump then @@ -156,7 +155,7 @@ package body Grt.Vital_Annotate is end if; end Sdf_Header; - procedure Sdf_Celltype (Context : in out Sdf_Context_Type) + procedure Sdf_Celltype (Context : Sdf_Context_Type) is begin if Flag_Dump then @@ -185,7 +184,7 @@ package body Grt.Vital_Annotate is Find_Instance (Sdf_Inst, Sdf_Inst, Instance, Status); end Sdf_Instance; - procedure Sdf_Instance_End (Context : in out Sdf_Context_Type; + procedure Sdf_Instance_End (Context : Sdf_Context_Type; Status : out Boolean) is begin @@ -319,6 +318,9 @@ package body Grt.Vital_Annotate is Right : VhpiIntT; begin Vhpi_Handle (VhpiSubtype, Port, Port_Type, Error); + Left := 0; + Len := 0; + Up := True; if Error /= AvhpiErrorOk then Internal_Error ("vhpiSubtype - port"); return; @@ -434,10 +436,10 @@ package body Grt.Vital_Annotate is then Generic_Get_Bounds (Port2, Left2, Len2, Up2); Pos := Pos * Len2; - if Up1 then + if Up2 then Pos := Pos + Ghdl_Index_Type (Context.Ports (2).L - Left2); else - Pos := Pos + Ghdl_Index_Type (Left1 - Context.Ports (2).L); + Pos := Pos + Ghdl_Index_Type (Left2 - Context.Ports (2).L); end if; end if; Vhpi_Handle_By_Index @@ -608,8 +610,9 @@ package body Grt.Vital_Annotate is end loop; end Sdf_Start; - function Sdf_Option (Opt : String) return Boolean + function Sdf_Option (Option : String) return Boolean is + Opt : constant String (1 .. Option'Length) := Option; begin if Opt'Length > 11 and then Opt (1 .. 11) = "--sdf-dump=" then Flag_Dump := True; diff --git a/translate/grt/grt-vital_annotate.ads b/translate/grt/grt-vital_annotate.ads index f1a8b02..6c1d3a6 100644 --- a/translate/grt/grt-vital_annotate.ads +++ b/translate/grt/grt-vital_annotate.ads @@ -20,12 +20,12 @@ with Grt.Sdf; use Grt.Sdf; package Grt.Vital_Annotate is pragma Elaborate_Body (Grt.Vital_Annotate); - procedure Sdf_Header (Context : in out Sdf_Context_Type); - procedure Sdf_Celltype (Context : in out Sdf_Context_Type); + procedure Sdf_Header (Context : Sdf_Context_Type); + procedure Sdf_Celltype (Context : Sdf_Context_Type); procedure Sdf_Instance (Context : in out Sdf_Context_Type; Instance : String; Status : out Boolean); - procedure Sdf_Instance_End (Context : in out Sdf_Context_Type; + procedure Sdf_Instance_End (Context : Sdf_Context_Type; Status : out Boolean); procedure Sdf_Generic (Context : in out Sdf_Context_Type; Name : String; diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index 2af34a2..ff311be 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -40,15 +40,17 @@ with Ada.Unchecked_Deallocation; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Stdio; use Grt.Stdio; with Grt.C; use Grt.C; with Grt.Signals; use Grt.Signals; -with GNAT.Table; +with Grt.Table; with Grt.Astdio; use Grt.Astdio; with Grt.Hooks; use Grt.Hooks; with Grt.Vcd; use Grt.Vcd; with Grt.Errors; use Grt.Errors; with Grt.Rtis_Types; +pragma Elaborate_All (Grt.Table); package body Grt.Vpi is -- The VPI interface requires libdl (dlopen, dlsym) to be linked in. @@ -69,6 +71,7 @@ package body Grt.Vpi is procedure dbgPut (Str : String) is S : size_t; + pragma Unreferenced (S); begin S := fwrite (Str'Address, Str'Length, 1, stderr); end dbgPut; @@ -76,6 +79,7 @@ package body Grt.Vpi is procedure dbgPut (C : Character) is R : int; + pragma Unreferenced (R); begin R := fputc (Character'Pos (C), stderr); end dbgPut; @@ -722,12 +726,11 @@ package body Grt.Vpi is Cb : s_cb_data; end record; - package Vpi_Table is new GNAT.Table + package Vpi_Table is new Grt.Table (Table_Component_Type => Vpi_Var_Type, Table_Index_Type => Vpi_Index_Type, Table_Low_Bound => 0, - Table_Initial => 32, - Table_Increment => 100); + Table_Initial => 32); function vpi_register_cb (Data : p_cb_data) return vpiHandle is @@ -865,7 +868,7 @@ package body Grt.Vpi is -- Return TRUE if OPT is an option for VPI. function Vpi_Option (Opt : String) return Boolean is - F : Natural := Opt'First; + F : constant Natural := Opt'First; begin if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then return False; @@ -918,6 +921,7 @@ package body Grt.Vpi is procedure Vpi_Start is Res : Integer; + pragma Unreferenced (Res); begin if Vpi_Filename = null then return; @@ -935,6 +939,7 @@ package body Grt.Vpi is procedure Vpi_Cycle is Res : Integer; + pragma Unreferenced (Res); begin if g_cbReadOnlySync /= null and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000) @@ -959,6 +964,7 @@ package body Grt.Vpi is procedure Vpi_End is Res : Integer; + pragma Unreferenced (Res); begin if g_cbEndOfSimulation /= null then Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation); diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb index d17cc87..bb62d28 100644 --- a/translate/grt/grt-vstrings.adb +++ b/translate/grt/grt-vstrings.adb @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); with Grt.Errors; use Grt.Errors; with Grt.C; use Grt.C; @@ -41,7 +42,7 @@ package body Grt.Vstrings is procedure Grow (Vstr : in out Vstring; Sum : Natural) is - Nlen : Natural := Vstr.Len + Sum; + Nlen : constant Natural := Vstr.Len + Sum; Nmax : Natural; begin Vstr.Len := Nlen; @@ -72,7 +73,7 @@ package body Grt.Vstrings is procedure Append (Vstr : in out Vstring; Str : String) is - S : Natural := Vstr.Len; + S : constant Natural := Vstr.Len; begin Grow (Vstr, Str'Length); Vstr.Str (S + 1 .. S + Str'Length) := Str; @@ -80,8 +81,8 @@ package body Grt.Vstrings is procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String) is - S : Natural := Vstr.Len; - L : Natural := strlen (Str); + S : constant Natural := Vstr.Len; + L : constant Natural := strlen (Str); begin Grow (Vstr, L); Vstr.Str (S + 1 .. S + L) := Str (1 .. L); @@ -125,8 +126,8 @@ package body Grt.Vstrings is procedure Grow (Rstr : in out Rstring; Min : Natural) is - Len : Natural := Length (Rstr); - Nlen : Natural := Len + Min; + Len : constant Natural := Length (Rstr); + Nlen : constant Natural := Len + Min; Nstr : Fat_String_Acc; Nfirst : Natural; Nmax : Natural; @@ -171,7 +172,7 @@ package body Grt.Vstrings is procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String) is - L : Natural := strlen (Str); + L : constant Natural := strlen (Str); begin Grow (Rstr, L); Rstr.First := Rstr.First - L; @@ -199,6 +200,7 @@ package body Grt.Vstrings is procedure Put (Stream : FILEs; Rstr : Rstring) is S : size_t; + pragma Unreferenced (S); begin S := fwrite (Get_Address (Rstr), size_t (Length (Rstr)), 1, Stream); end Put; diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb index c2c0138..fc10950 100644 --- a/translate/grt/grt-waves.adb +++ b/translate/grt/grt-waves.adb @@ -19,16 +19,15 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Interfaces; use Interfaces; with System.Storage_Elements; -- Work around GNAT bug. +pragma Unreferenced (System.Storage_Elements); 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; with Grt.Hooks; use Grt.Hooks; -with Grt.Avhpi; use Grt.Avhpi; -with GNAT.Table; +with Grt.Table; with Grt.Avls; use Grt.Avls; with Grt.Rtis; use Grt.Rtis; with Grt.Rtis_Addr; use Grt.Rtis_Addr; @@ -39,6 +38,7 @@ with System; use System; with Grt.Vstrings; use Grt.Vstrings; pragma Elaborate_All (Grt.Rtis_Utils); +pragma Elaborate_All (Grt.Table); package body Grt.Waves is -- Waves filename. @@ -62,10 +62,13 @@ package body Grt.Waves is Ghw_Hie_Port_Buffer : constant Unsigned_8 := 20; -- Port Ghw_Hie_Port_Linkage : constant Unsigned_8 := 21; -- Port + pragma Unreferenced (Ghw_Hie_Design); + pragma Unreferenced (Ghw_Hie_Generic); + -- Return TRUE if OPT is an option for wave. function Wave_Option (Opt : String) return Boolean is - F : Natural := Opt'First; + F : constant Natural := Opt'First; begin if Opt'Length < 6 or else Opt (F .. F + 5) /= "--wave" then return False; @@ -89,6 +92,7 @@ package body Grt.Waves is procedure Wave_Put (Str : String) is R : size_t; + pragma Unreferenced (R); begin R := fwrite (Str'Address, Str'Length, 1, Wave_Stream); end Wave_Put; @@ -96,6 +100,7 @@ package body Grt.Waves is procedure Wave_Putc (C : Character) is R : int; + pragma Unreferenced (R); begin R := fputc (Character'Pos (C), Wave_Stream); end Wave_Putc; @@ -109,6 +114,7 @@ package body Grt.Waves is is V : Unsigned_8 := B; R : size_t; + pragma Unreferenced (R); begin R := fwrite (V'Address, 1, 1, Wave_Stream); end Wave_Put_Byte; @@ -180,6 +186,7 @@ package body Grt.Waves is is V : Ghdl_I32 := Val; R : size_t; + pragma Unreferenced (R); begin R := fwrite (V'Address, 4, 1, Wave_Stream); end Wave_Put_I32; @@ -188,6 +195,7 @@ package body Grt.Waves is is V : Ghdl_I64 := Val; R : size_t; + pragma Unreferenced (R); begin R := fwrite (V'Address, 8, 1, Wave_Stream); end Wave_Put_I64; @@ -196,6 +204,7 @@ package body Grt.Waves is is V : Ghdl_F64 := F64; R : size_t; + pragma Unreferenced (R); begin R := fwrite (V'Address, Ghdl_F64'Size / Storage_Unit, 1, Wave_Stream); end Wave_Put_F64; @@ -229,12 +238,11 @@ package body Grt.Waves is Pos : long; end record; - package Section_Table is new GNAT.Table + package Section_Table is new Grt.Table (Table_Component_Type => Header_Type, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); -- Create a new section. -- Write the header in the file. @@ -270,13 +278,7 @@ package body Grt.Waves is Wave_Put_Byte (V); end; -- Word size, 1 byte. - if Integer'Size = 32 then - Wave_Put_Byte (4); - elsif Integer'Size = 64 then - Wave_Put_Byte (8); - else - Wave_Put_Byte (0); - end if; + Wave_Put_Byte (Integer'Size / 8); -- File offset size, 1 byte Wave_Put_Byte (1); -- Unused, must be zero (MBZ). @@ -347,19 +349,17 @@ package body Grt.Waves is null; end Avhpi_Error; - package Str_Table is new GNAT.Table + package Str_Table is new Grt.Table (Table_Component_Type => Ghdl_C_String, Table_Index_Type => AVL_Value, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); - package Str_AVL is new GNAT.Table + package Str_AVL is new Grt.Table (Table_Component_Type => AVL_Node, Table_Index_Type => AVL_Nid, Table_Low_Bound => AVL_Root, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); Strings_Len : Natural := 0; @@ -394,6 +394,8 @@ package body Grt.Waves is New_Line (stdout); end Disp_Str_Avl; + pragma Unreferenced (Disp_Str_Avl); + function Create_Str_Index (Str : Ghdl_C_String) return AVL_Value is Res : AVL_Nid; @@ -414,6 +416,8 @@ package body Grt.Waves is return Str_AVL.Table (Res).Val; end Create_Str_Index; + pragma Unreferenced (Create_Str_Index); + procedure Create_String_Id (Str : Ghdl_C_String) is Res : AVL_Nid; @@ -472,23 +476,20 @@ package body Grt.Waves is Context : Rti_Context; end record; - package Types_Table is new GNAT.Table + package Types_Table is new Grt.Table (Table_Component_Type => Type_Node, Table_Index_Type => AVL_Value, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); - package Types_AVL is new GNAT.Table + package Types_AVL is new Grt.Table (Table_Component_Type => AVL_Node, Table_Index_Type => AVL_Nid, Table_Low_Bound => AVL_Root, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); function Type_Compare (L, R : AVL_Value) return Integer is - use System; function To_Ia is new Ada.Unchecked_Conversion (Ghdl_Rti_Access, Integer_Address); @@ -1049,6 +1050,8 @@ package body Grt.Waves is fflush (Wave_Stream); end Write_Strings; + pragma Unreferenced (Write_Strings); + procedure Freeze_Strings is type Str_Table1_Type is array (1 .. Str_Table.Last) of Ghdl_C_String; @@ -1380,18 +1383,19 @@ package body Grt.Waves is end Write_Known_Types; -- Table of signals to be dumped. - package Dump_Table is new GNAT.Table + package Dump_Table is new Grt.Table (Table_Component_Type => Ghdl_Signal_Ptr, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 32, - Table_Increment => 100); + Table_Initial => 32); function Get_Dump_Entry (N : Natural) return Ghdl_Signal_Ptr is begin return Dump_Table.Table (N); end Get_Dump_Entry; + pragma Unreferenced (Get_Dump_Entry); + procedure Write_Hierarchy (Root : VhpiHandleT) is N : Natural; diff --git a/translate/grt/grt.adc b/translate/grt/grt.adc index 54b06c0..586a54e 100644 --- a/translate/grt/grt.adc +++ b/translate/grt/grt.adc @@ -28,10 +28,12 @@ -- This files is *not* names gnat.adc, in order to ease the possibility of -- not using it. pragma Restrictions (No_Exception_Handlers); -pragma restrictions (No_Exceptions); +--pragma restrictions (No_Exceptions); pragma Restrictions (No_Secondary_Stack); --pragma Restrictions (No_Elaboration_Code); pragma Restrictions (No_Io); +pragma restrictions (no_dependence => Ada.Tags); +pragma restrictions (no_dependence => GNAT); pragma Restrictions (Max_Tasks => 0); pragma Restrictions (No_Implicit_Heap_Allocations); pragma No_Run_Time; |