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 | |
| 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')
54 files changed, 589 insertions, 476 deletions
diff --git a/translate/Makefile b/translate/Makefile index 32128c4..1fb63e5 100644 --- a/translate/Makefile +++ b/translate/Makefile @@ -18,7 +18,7 @@ BE=gcc ortho_srcdir=../ortho -GNAT_FLAGS=-aI.. -gnaty3befhkmr -gnata -gnatf -gnatwlcru +GNAT_FLAGS=-aI.. -gnaty3befhkmr -gnata -gnatf -gnatwa -gnatwe #GNAT_FLAGS+=-O -gnatn LN=ln -s diff --git a/translate/gcc/Make-lang.in b/translate/gcc/Make-lang.in index 0139c2c..308f400 100644 --- a/translate/gcc/Make-lang.in +++ b/translate/gcc/Make-lang.in @@ -79,7 +79,7 @@ ghdl1$(exeext): $(AGCC_OBJS) $(AGCC_DEPS) force -cargs $(CFLAGS) $(GHDL_ADAFLAGS) $(GNATMAKE) -o $@ -aI$(srcdir)/vhdl -aOvhdl ortho_gcc-main \ -bargs -E -cargs $(CFLAGS) $(GHDL_ADAFLAGS) \ - -largs $(AGCC_OBJS) $(LIBS) + -largs $(AGCC_OBJS) $(LIBS) $(GMPLIBS) # The driver for ghdl. ghdl$(exeext): force diff --git a/translate/gcc/dist-common.sh b/translate/gcc/dist-common.sh index 46d3478..58c8ba5 100644 --- a/translate/gcc/dist-common.sh +++ b/translate/gcc/dist-common.sh @@ -158,8 +158,13 @@ grt_files=" grt-cbinding.c grt-cvpi.c grt.adc +grt-astdio.ads +grt-astdio.adb grt-avhpi.adb grt-avhpi.ads +grt-avls.ads +grt-avls.adb +grt-c.ads grt-disp.adb grt-disp.ads grt-disp_rti.adb @@ -176,8 +181,6 @@ grt-hooks.adb grt-hooks.ads grt-images.adb grt-images.ads -grt-values.adb -grt-values.ads grt-lib.adb grt-lib.ads grt-main.adb @@ -208,12 +211,16 @@ grt-stack2.adb grt-stack2.ads grt-stacks.adb grt-stacks.ads -grt-c.ads -grt-zlib.ads +grt-stats.ads +grt-stats.adb grt-stdio.ads -grt-astdio.ads -grt-astdio.adb +grt-table.ads +grt-table.adb grt-types.ads +grt-unithread.ads +grt-unithread.adb +grt-values.adb +grt-values.ads grt-vcd.adb grt-vcd.ads grt-vcdz.adb @@ -224,14 +231,9 @@ grt-vpi.adb grt-vpi.ads grt-vstrings.adb grt-vstrings.ads -grt-stats.ads -grt-stats.adb grt-waves.ads grt-waves.adb -grt-avls.ads -grt-avls.adb -grt-unithread.ads -grt-unithread.adb +grt-zlib.ads grt-threads.ads grt-arch_none.ads grt-arch_none.adb diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh index 97dff90..da78ff0 100755 --- a/translate/gcc/dist.sh +++ b/translate/gcc/dist.sh @@ -39,7 +39,7 @@ set -e # GCC version -GCCVERSION=4.2.4 +GCCVERSION=4.3.1 # Machine name used by GCC MACHINE=i686-pc-linux-gnu # Directory where GCC sources (and objects) stay. @@ -170,7 +170,7 @@ do_compile () rm -rf $GCCDISTOBJ mkdir $GCCDISTOBJ cd $GCCDISTOBJ - ../gcc-$GCCVERSION/configure --enable-languages=vhdl --prefix=$PREFIX --disable-bootstrap + ../gcc-$GCCVERSION/configure --enable-languages=vhdl --prefix=$PREFIX --disable-bootstrap --with-bugurl="<URL:http://gna.org/projects/ghdl>" make CFLAGS="-O -g" make -C gcc vhdl.info cd $CWD diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 9e9e1e0..0d76bc5 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -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. -GNATFLAGS=-gnaty3befhkmr -gnata -gnatwu -gnatwl -aI../.. -aI.. -aI../grt -aO.. -g -gnatf +GNATFLAGS=-gnaty3befhkmr -gnata -gnatwae -aI../.. -aI.. -aI../grt -aO.. -g -gnatf GRT_FLAGS=-g LIB_CFLAGS=-g -O2 +GNATMAKE=gnatmake +CC=gcc # Optimize, do not forget to use MODE=--genfast for iirs.adb. #GNATFLAGS+=-O -gnatn @@ -52,13 +54,13 @@ ortho_code-x86-flags.ads: ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force - gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) + $(GNATMAKE) -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) -largs -L/usr/lib32 memsegs_c.o: ../../ortho/mcode/memsegs_c.c $(CC) -c -g -o $@ $< ghdl_gcc: default_pathes.ads force - gnatmake $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS) + $(GNATMAKE) $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS) ghdl_simul: default_pathes.ads force gnatmake -aI../../simulate $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) @@ -116,7 +118,7 @@ install.v87: std.v87 ieee.v87 synopsys.v87 install.standard: $(LIB93_DIR)/std/std_standard.o \ $(LIB87_DIR)/std/std_standard.o -make-lib-links: +grt.links: cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver . install.all: install.v87 install.v93 install.standard diff --git a/translate/ghdldrv/ghdlcomp.adb b/translate/ghdldrv/ghdlcomp.adb index a3895f9..4dcd208 100644 --- a/translate/ghdldrv/ghdlcomp.adb +++ b/translate/ghdldrv/ghdlcomp.adb @@ -122,9 +122,6 @@ package body Ghdlcomp is end; Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last)); Hooks.Run.all; - exception - when Errorout.Option_Error => - raise; end Perform_Action; @@ -197,7 +194,7 @@ package body Ghdlcomp is Elab_Arg := Natural'Last; for I in Args'Range loop declare - Arg : String := Args (I).all; + Arg : constant String := Args (I).all; Res : Iir_Design_File; Design : Iir; Next_Design : Iir; @@ -246,9 +243,6 @@ package body Ghdlcomp is Error_Msg_Option ("options after unit are ignored"); end if; end if; - exception - when Errorout.Option_Error => - raise; end Perform_Action; -- Command -a @@ -346,8 +340,6 @@ package body Ghdlcomp is else raise; end if; - when Errorout.Option_Error => - raise; end Perform_Action; -- Command -e @@ -427,8 +419,6 @@ package body Ghdlcomp is else raise; end if; - when Errorout.Option_Error => - raise; end Perform_Action; -- Command dispconfig. @@ -636,7 +626,7 @@ package body Ghdlcomp is Put ("GHDLFLAGS="); for I in 2 .. Argument_Count loop declare - Arg : String := Argument (I); + Arg : constant String := Argument (I); begin if Arg (1) = '-' then if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=") diff --git a/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb index 52b7e5a..9de01b4 100644 --- a/translate/ghdldrv/ghdldrv.adb +++ b/translate/ghdldrv/ghdldrv.adb @@ -57,9 +57,6 @@ package body Ghdldrv is -- "-o" string. Dash_O : String_Access; - -- "-S" string. - Dash_S : String_Access; - -- "-quiet" option. Dash_Quiet : String_Access; @@ -155,7 +152,8 @@ package body Ghdldrv is -- Compile. declare P : Natural; - Nbr_Args : Natural := Last (Compiler_Args) + Options'Length + 4; + Nbr_Args : constant Natural := + Last (Compiler_Args) + Options'Length + 4; Args : Argument_List (1 .. Nbr_Args); begin P := 0; @@ -199,7 +197,7 @@ package body Ghdldrv is if Compile_Kind = Compile_Debug then declare P : Natural; - Nbr_Args : Natural := Last (Postproc_Args) + 4; + Nbr_Args : constant Natural := Last (Postproc_Args) + 4; Args : Argument_List (1 .. Nbr_Args); begin P := 0; @@ -229,7 +227,7 @@ package body Ghdldrv is elsif not Flag_Asm then declare P : Natural; - Nbr_Args : Natural := Last (Assembler_Args) + 4; + Nbr_Args : constant Natural := Last (Assembler_Args) + 4; Args : Argument_List (1 .. Nbr_Args); Success : Boolean; begin @@ -358,7 +356,6 @@ package body Ghdldrv is is use Files_Map; - Dir : Name_Id; Name : Name_Id; File : Source_File_Entry; @@ -368,7 +365,6 @@ package body Ghdldrv is return False; end if; - Dir := Get_Library_Directory (Get_Library (Design_File)); Name := Get_Design_File_Filename (Design_File); declare Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul; @@ -539,7 +535,6 @@ package body Ghdldrv is Tool_Not_Found (Linker_Cmd); end if; Dash_O := new String'("-o"); - Dash_S := new String'("-S"); Dash_Quiet := new String'("-quiet"); end Locate_Tools; @@ -596,88 +591,87 @@ package body Ghdldrv is Res : out Option_Res) is Str : String_Access; + Opt : constant String (1 .. Option'Length) := Option; begin Res := Option_Bad; - if Option = "-v" and then Flag_Verbose = False then + if Opt = "-v" and then Flag_Verbose = False then -- Note: this is also decoded for command_lib, but we set -- Flag_Disp_Commands too. Flag_Verbose := True; --Flags.Verbose := True; Flag_Disp_Commands := True; Res := Option_Ok; - elsif Option'Length > 8 and then Option (1 .. 8) = "--GHDL1=" then - Compiler_Cmd := new String'(Option (9 .. Option'Last)); + elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then + Compiler_Cmd := new String'(Opt (9 .. Opt'Last)); Res := Option_Ok; - elsif Option = "-S" then + elsif Opt = "-S" then Flag_Asm := True; Res := Option_Ok; - elsif Option = "--post" then + elsif Opt = "--post" then Compile_Kind := Compile_Debug; Res := Option_Ok; - elsif Option = "--mcode" then + elsif Opt = "--mcode" then Compile_Kind := Compile_Mcode; Res := Option_Ok; - elsif Option = "-o" then + elsif Opt = "-o" then if Arg'Length = 0 then Res := Option_Arg_Req; else Output_File := new String'(Arg); Res := Option_Arg; end if; - elsif Option = "-m32" then + elsif Opt = "-m32" then Add_Argument (Compiler_Args, new String'("-m32")); Add_Argument (Assembler_Args, new String'("--32")); Add_Argument (Linker_Args, new String'("-m32")); - Decode_Option (Command_Lib (Cmd), Option, Arg, Res); - elsif Option'Length > 4 - and then Option (2) = 'W' and then Option (4) = ',' + Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); + elsif Opt'Length > 4 + and then Opt (2) = 'W' and then Opt (4) = ',' then - if Option (3) = 'c' then - Add_Arguments (Compiler_Args, Option); - elsif Option (3) = 'a' then - Add_Arguments (Assembler_Args, Option); - elsif Option (3) = 'p' then - Add_Arguments (Postproc_Args, Option); - elsif Option (3) = 'l' then - Add_Arguments (Linker_Args, Option); + if Opt (3) = 'c' then + Add_Arguments (Compiler_Args, Opt); + elsif Opt (3) = 'a' then + Add_Arguments (Assembler_Args, Opt); + elsif Opt (3) = 'p' then + Add_Arguments (Postproc_Args, Opt); + elsif Opt (3) = 'l' then + Add_Arguments (Linker_Args, Opt); else Error - ("unknown tool name in '-W" & Option (3) & ",' option"); + ("unknown tool name in '-W" & Opt (3) & ",' option"); raise Option_Error; end if; Res := Option_Ok; - elsif Option'Length >= 2 and then Option (2) = 'g' then + elsif Opt'Length >= 2 and then Opt (2) = 'g' then -- Debugging option. - Str := new String'(Option); + Str := new String'(Opt); Add_Argument (Compiler_Args, Str); Add_Argument (Linker_Args, Str); Res := Option_Ok; - elsif Option = "-Q" then + elsif Opt = "-Q" then Flag_Not_Quiet := True; Res := Option_Ok; - elsif Option = "--expect-failure" then - Add_Argument (Compiler_Args, new String'(Option)); + elsif Opt = "--expect-failure" then + Add_Argument (Compiler_Args, new String'(Opt)); Flag_Expect_Failure := True; Res := Option_Ok; - elsif Flags.Parse_Option (Option) then - Add_Argument (Compiler_Args, new String'(Option)); + elsif Flags.Parse_Option (Opt) then + Add_Argument (Compiler_Args, new String'(Opt)); Res := Option_Ok; - elsif Option'Length >= 2 - and then (Option (2) = 'O' or Option (2) = 'f') + elsif Opt'Length >= 2 + and then (Opt (2) = 'O' or Opt (2) = 'f') then -- Optimization option. -- This is put after Flags.Parse_Option, since it may catch -fxxx -- options. - Add_Argument (Compiler_Args, new String'(Option)); + Add_Argument (Compiler_Args, new String'(Opt)); Res := Option_Ok; else - Decode_Option (Command_Lib (Cmd), Option, Arg, Res); + Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Comp) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Comp) is begin Disp_Long_Help (Command_Lib (Cmd)); Put_Line (" -v Be verbose"); @@ -719,7 +713,6 @@ package body Ghdldrv is procedure Perform_Action (Cmd : in out Command_Dispconfig; Args : Argument_List) is - use Ada.Text_IO; use Libraries; pragma Unreferenced (Cmd); begin @@ -912,7 +905,7 @@ package body Ghdldrv is -- call the linker declare P : Natural; - Nbr_Args : Natural := Last (Linker_Args) + Filelist.Last + 4; + Nbr_Args : constant Natural := Last (Linker_Args) + Filelist.Last + 4; Args : Argument_List (1 .. Nbr_Args); Obj_File : String_Access; Std_File : String_Access; @@ -997,6 +990,7 @@ package body Ghdldrv is is pragma Unreferenced (Cmd); Success : Boolean; + pragma Unreferenced (Success); begin Set_Elab_Units ("-e", Args); Setup_Compiler (False); @@ -1614,7 +1608,7 @@ package body Ghdldrv is Put ("GHDLFLAGS="); for I in 2 .. Argument_Count loop declare - Arg : String := Argument (I); + Arg : constant String := Argument (I); begin if Arg (1) = '-' then if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=") diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index fb8f5f6..6565f9d 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; -with Ghdlmain; with Types; use Types; with Libraries; with Std_Package; @@ -40,7 +39,7 @@ package body Ghdllocal is type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor); Flag_Ieee : Ieee_Lib_Kind; - Flag_Create_Default_Config : Boolean := True; + Flag_Create_Default_Config : constant Boolean := True; -- If TRUE, generate 32bits code on 64bits machines. Flag_32bit : Boolean := False; @@ -108,36 +107,37 @@ package body Ghdllocal is is pragma Unreferenced (Cmd); pragma Unreferenced (Arg); + Opt : constant String (1 .. Option'Length) := Option; begin Res := Option_Bad; - if Option = "-v" and then Flag_Verbose = False then + if Opt = "-v" and then Flag_Verbose = False then Flag_Verbose := True; Res := Option_Ok; - elsif Option'Length > 9 and then Option (1 .. 9) = "--PREFIX=" then - Prefix_Path := new String'(Option (10 .. Option'Last)); + elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then + Prefix_Path := new String'(Opt (10 .. Opt'Last)); Res := Option_Ok; - elsif Option = "--ieee=synopsys" then + elsif Opt = "--ieee=synopsys" then Flag_Ieee := Lib_Synopsys; Res := Option_Ok; - elsif Option = "--ieee=mentor" then + elsif Opt = "--ieee=mentor" then Flag_Ieee := Lib_Mentor; Res := Option_Ok; - elsif Option = "--ieee=none" then + elsif Opt = "--ieee=none" then Flag_Ieee := Lib_None; Res := Option_Ok; - elsif Option = "--ieee=standard" then + elsif Opt = "--ieee=standard" then Flag_Ieee := Lib_Standard; Res := Option_Ok; - elsif Option = "-m32" then + elsif Opt = "-m32" then Flag_32bit := True; Res := Option_Ok; - elsif Option'Length >= 2 - and then (Option (2) = 'g' or Option (2) = 'O') + elsif Opt'Length >= 2 + and then (Opt (2) = 'g' or Opt (2) = 'O') then -- Silently accept -g and -O. Res := Option_Ok; else - if Flags.Parse_Option (Option) then + if Flags.Parse_Option (Opt) then Res := Option_Ok; end if; end if; @@ -326,7 +326,7 @@ package body Ghdllocal is function Append_Suffix (File : String; Suffix : String) return String_Access is use Name_Table; - Basename : String := Get_Base_Name (File); + Basename : constant String := Get_Base_Name (File); begin Image (Libraries.Work_Directory); Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) := @@ -429,7 +429,7 @@ package body Ghdllocal is Design_File : Iir_Design_File; Unit : Iir; Lib : Iir; - Flag_Add : Boolean := False; + Flag_Add : constant Boolean := False; begin Flags.Bootstrap := True; Libraries.Load_Std_Library; @@ -646,7 +646,6 @@ package body Ghdllocal is procedure Delete (Str : String) is - use GNAT.OS_Lib; use Ada.Text_IO; Status : Boolean; begin @@ -659,7 +658,6 @@ package body Ghdllocal is procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List) is pragma Unreferenced (Cmd); - use GNAT.OS_Lib; use Name_Table; procedure Delete_Asm_Obj (Str : String) is @@ -805,6 +803,7 @@ package body Ghdllocal is procedure Extract_Library_Clauses (Unit : Iir_Design_Unit) is Lib1 : Iir_Library_Declaration; + pragma Unreferenced (Lib1); Ctxt_Item : Iir; begin -- Extract library clauses. @@ -1059,7 +1058,7 @@ package body Ghdllocal is if Args'Length >= 2 then declare - Sec : String_Access := Args (Next_Arg); + Sec : constant String_Access := Args (Next_Arg); begin if Sec (Sec'First) /= '-' then Sec_Name := Convert_Name (Sec); diff --git a/translate/ghdldrv/ghdlmain.adb b/translate/ghdldrv/ghdlmain.adb index 0f43929..b77ceca 100644 --- a/translate/ghdldrv/ghdlmain.adb +++ b/translate/ghdldrv/ghdlmain.adb @@ -20,7 +20,6 @@ with Ada.Command_Line; with Version; with Flags; with Bug; -with Errorout; package body Ghdlmain is procedure Init (Cmd : in out Command_Type) @@ -275,7 +274,7 @@ package body Ghdlmain is Arg_Index := 2; while Arg_Index <= Argument_Count loop declare - Arg : String := Argument (Arg_Index); + Arg : constant String := Argument (Arg_Index); Res : Option_Res; begin if Arg (1) = '-' then diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb index 45750ef..3dc5550 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -84,9 +84,6 @@ package body Ghdlprint is Buf : File_Buffer_Acc; Prev_Tok : Token_Type; - -- True if tokens are between 'end' and ';' - In_End : Boolean := False; - -- Current logical column number. Used to expand TABs. Col : Natural; @@ -372,9 +369,7 @@ package body Ghdlprint is Disp_Reserved; when Tok_End => Disp_Reserved; - In_End := True; when Tok_Semi_Colon => - In_End := False; Disp_Spaces; Disp_Text; when Tok_Xnor .. Tok_Ror => @@ -944,9 +939,7 @@ package body Ghdlprint is end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Html) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Html) is begin Disp_Long_Help (Command_Lib (Cmd)); Put_Line ("--format=html2 Use FONT attributes"); @@ -1068,9 +1061,7 @@ package body Ghdlprint is end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Xref_Html) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Xref_Html) is begin Disp_Long_Help (Command_Html (Cmd)); Put_Line ("-o DIR Put generated files into DIR (def: html/)"); @@ -1115,7 +1106,6 @@ package body Ghdlprint is Files : File_Data_Array; Output : File_Type; - Prev_Output : File_Access; begin Xrefs.Init; Flags.Flag_Xref := True; @@ -1220,8 +1210,6 @@ package body Ghdlprint is Filexref_Info (Files (I).Fe).Output := Files (I).Output; end loop; - Prev_Output := Current_Input; - for I in Files'Range loop if Cmd.Output_Dir /= null then Create (Output, Out_File, @@ -1304,7 +1292,7 @@ package body Ghdlprint is and then Cmd.Output_Dir /= null then declare - Css_Filename : String := + Css_Filename : constant String := Cmd.Output_Dir.all & Directory_Separator & "ghdl.css"; begin if not Is_Regular_File (Css_Filename & Nul) then @@ -1427,6 +1415,7 @@ package body Ghdlprint is Loc_File : Source_File_Entry; Loc_Pos : Source_Ptr; C : Character; + Dir : Name_Id; begin New_Line; Cur_Decl := N; @@ -1435,8 +1424,11 @@ package body Ghdlprint is if Loc_File /= Cur_File then Cur_File := Loc_File; Put ("XFILE: "); - Image (Get_Source_File_Directory (Cur_File)); - Put (Name_Buffer (1 .. Name_Length)); + Dir := Get_Source_File_Directory (Cur_File); + if Dir /= Null_Identifier then + Image (Dir); + Put (Name_Buffer (1 .. Name_Length)); + end if; Image (Get_File_Name (Cur_File)); Put (Name_Buffer (1 .. Name_Length)); New_Line; @@ -1537,8 +1529,6 @@ package body Ghdlprint is Emit_Ref (I, 'r'); when Xref_Body => Emit_Ref (I, 'b'); - when others => - null; end case; end if; end loop; diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 4bae12d..f60504a 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -29,7 +29,6 @@ with Binary_File; use Binary_File; with Binary_File.Memory; with Ortho_Mcode; use Ortho_Mcode; with Ortho_Code.Flags; use Ortho_Code.Flags; -with Binary_File; with Interfaces; with System; use System; with Trans_Decls; @@ -46,7 +45,6 @@ with Trans_Be; with Translation; with Std_Names; with Ieee.Std_Logic_1164; -with Interfaces.C; with Binary_File.Elf; @@ -250,8 +248,9 @@ package body Ghdlrun is case Info.Kind is when Foreign_Vhpidirect => declare - Name : String := Name_Table.Name_Buffer (Info.Subprg_First - .. Info.Subprg_Last); + Name : constant String := + Name_Table.Name_Buffer (Info.Subprg_First + .. Info.Subprg_Last); begin Res := Foreigns.Find_Foreign (Name); if Res /= Null_Address then @@ -270,7 +269,6 @@ package body Ghdlrun is procedure Run is - use Binary_File; use Interfaces; use Ortho_Code.Binary; @@ -632,15 +630,16 @@ package body Ghdlrun is function Decode_Option (Option : String) return Boolean is + Opt : constant String (1 .. Option'Length) := Option; begin - if Option = "-g" then + if Opt = "-g" then Flag_Debug := Debug_Dwarf; return True; - elsif Option'Length > 5 and then Option (1 .. 5) = "--be-" then - Ortho_Code.Debug.Set_Be_Flag (Option); + elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then + Ortho_Code.Debug.Set_Be_Flag (Opt); return True; - elsif Option'Length > 7 and then Option (1 .. 7) = "--snap=" then - Snap_Filename := new String'(Option (8 .. Option'Last)); + elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then + Snap_Filename := new String'(Opt (8 .. Opt'Last)); return True; else return False; 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; diff --git a/translate/trans_analyzes.adb b/translate/trans_analyzes.adb index a6d5619..43d7508 100644 --- a/translate/trans_analyzes.adb +++ b/translate/trans_analyzes.adb @@ -33,6 +33,7 @@ package body Trans_Analyzes is function Extract_Driver_Stmt (Stmt : Iir) return Walk_Status is Status : Walk_Status; + pragma Unreferenced (Status); We : Iir; begin case Get_Kind (Stmt) is @@ -91,6 +92,7 @@ package body Trans_Analyzes is procedure Extract_Drivers_Sequential_Stmt_Chain (Chain : Iir) is Status : Walk_Status; + pragma Unreferenced (Status); begin Status := Walk_Sequential_Stmt_Chain (Chain, Extract_Driver_Stmt'Access); end Extract_Drivers_Sequential_Stmt_Chain; diff --git a/translate/trans_be.adb b/translate/trans_be.adb index 13b82fc..0725fb7 100644 --- a/translate/trans_be.adb +++ b/translate/trans_be.adb @@ -135,6 +135,7 @@ package body Trans_Be is is use Translation; Fi : Foreign_Info_Type; + pragma Unreferenced (Fi); begin case Get_Kind (Decl) is when Iir_Kind_Design_Unit => diff --git a/translate/translation.adb b/translate/translation.adb index 72d4577..fb269ab 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -70,7 +70,6 @@ package body Translation is -- Global declarations. Ghdl_Ptr_Type : O_Tnode; - Const_Ptr_Type_Node : O_Tnode; Sizetype : O_Tnode; Ghdl_I32_Type : O_Tnode; Ghdl_I64_Type : O_Tnode; @@ -3114,7 +3113,7 @@ package body Translation is procedure Copy_Fat_Pointer (D : O_Dnode; S : O_Dnode; Ftype : Iir; Is_Sig : Object_Kind_Type) is - Info : Type_Info_Acc := Get_Info (Ftype); + Info : constant Type_Info_Acc := Get_Info (Ftype); begin New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (D), Info.T.Base_Field (Is_Sig)), @@ -3830,12 +3829,9 @@ package body Translation is procedure Translate_Entity_Init (Entity : Iir) is - Info : Block_Info_Acc; El : Iir; El_Type : Iir; begin - Info := Get_Info (Entity); - Push_Local_Factory; -- Generics. @@ -4716,7 +4712,6 @@ package body Translation is is Inter : Iir; Inter_Type : Iir; - Inter_Kind : Iir_Kind; Info : Subprg_Info_Acc; Arg_Info : Ortho_Info_Acc; Tinfo : Type_Info_Acc; @@ -4791,7 +4786,6 @@ package body Translation is while Inter /= Null_Iir loop Arg_Info := Add_Info (Inter, Kind_Interface); Inter_Type := Get_Type (Inter); - Inter_Kind := Get_Kind (Inter_Type); Tinfo := Get_Info (Inter_Type); if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration and then Get_Mode (Inter) in Iir_Out_Modes @@ -5206,6 +5200,7 @@ package body Translation is is Info : Ortho_Info_Acc; Final : Boolean; + pragma Unreferenced (Final); begin Info := Get_Info (Spec); Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg); @@ -5963,7 +5958,7 @@ package body Translation is return; end if; declare - Len : Natural := Get_File_Signature_Length (Type_Name); + Len : constant Natural := Get_File_Signature_Length (Type_Name); Sig : String (1 .. Len + 2); Off : Natural := 1; begin @@ -6822,6 +6817,7 @@ package body Translation is Mark : Id_Mark_Type; Info : Type_Info_Acc; Lock_Field : O_Fnode; + pragma Unreferenced (Lock_Field); begin Decl := Get_Protected_Type_Declaration (Bod); Info := Get_Info (Decl); @@ -7308,7 +7304,6 @@ package body Translation is Subtype_Info : Type_Info_Acc; Base_Info : Type_Info_Acc) is - Base_Type : Iir; Rng : Iir; Lo, Hi : Iir; begin @@ -7325,7 +7320,6 @@ package body Translation is Subtype_Info.T.Nocheck_Low := False; else -- Bounds are locally static. - Base_Type := Get_Base_Type (Def); Get_Low_High_Limit (Rng, Lo, Hi); Subtype_Info.T.Nocheck_Hi := Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode); @@ -7456,7 +7450,7 @@ package body Translation is when Iir_Kind_Access_Type_Definition => declare - Dtype : Iir := Get_Designated_Type (Def); + Dtype : constant Iir := Get_Designated_Type (Def); begin -- Translate the subtype if Is_Anonymous_Type_Definition (Dtype) then @@ -7487,10 +7481,7 @@ package body Translation is procedure Translate_Bool_Type_Definition (Def : Iir) is - Decl : Iir; - Id : Name_Id; Info : Type_Info_Acc; - Base_Type : Iir; begin -- If the definition is already translated, return now. Info := Get_Info (Def); @@ -7499,10 +7490,6 @@ package body Translation is end if; Info := Add_Info (Def, Kind_Type); - Base_Type := Get_Base_Type (Def); - Decl := Get_Type_Declarator (Def); - - Id := Get_Identifier (Decl); if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then raise Internal_Error; @@ -7577,9 +7564,7 @@ package body Translation is procedure Elab_Type_Definition (Def : Iir); procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes (Handle_A_Subtype => Elab_Type_Definition); - procedure Elab_Type_Definition (Def : Iir) - is - Info : Type_Info_Acc; + procedure Elab_Type_Definition (Def : Iir) is begin case Get_Kind (Def) is when Iir_Kind_Incomplete_Type_Definition => @@ -7604,8 +7589,6 @@ package body Translation is return; end if; - Info := Get_Info (Def); - Elab_Type_Definition_Depend (Def); Create_Type_Definition_Type_Range (Def); @@ -7865,13 +7848,10 @@ package body Translation is function Get_Array_Type_Length (Atype : Iir) return O_Enode is Index_List : Iir_List; - Index_Type : Iir; Nbr_Dim : Natural; Dim_Length : O_Enode; Res : O_Enode; Type_Info : Type_Info_Acc; - Binfo : Type_Info_Acc; - Index_Info : Type_Info_Acc; Bounds : Mnode; begin Index_List := Get_Index_Subtype_List (Atype); @@ -7891,10 +7871,7 @@ package body Translation is raise Internal_Error; end case; - Binfo := Get_Info (Get_Base_Type (Atype)); for Dim in 1 .. Nbr_Dim loop - Index_Type := Get_Nth_Element (Index_List, Dim - 1); - Index_Info := Get_Info (Get_Base_Type (Index_Type)); Dim_Length := M2E (Range_To_Length (Bounds_To_Range (Bounds, Atype, Dim))); if Dim = 1 then @@ -7909,13 +7886,10 @@ package body Translation is function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode is Index_List : Iir_List; - Index_Type : Iir; Nbr_Dim : Natural; Dim_Length : O_Enode; Res : O_Enode; Type_Info : Type_Info_Acc; - Binfo : Type_Info_Acc; - Index_Info : Type_Info_Acc; B : Mnode; begin Index_List := Get_Index_Subtype_List (Atype); @@ -7933,10 +7907,7 @@ package body Translation is raise Internal_Error; end case; - Binfo := Get_Info (Get_Base_Type (Atype)); for Dim in 1 .. Nbr_Dim loop - Index_Type := Get_Nth_Element (Index_List, Dim - 1); - Index_Info := Get_Info (Get_Base_Type (Index_Type)); B := Get_Array_Bounds (Arr); Dim_Length := M2E (Range_To_Length (Bounds_To_Range (B, Atype, Dim))); @@ -7958,11 +7929,9 @@ package body Translation is when Type_Mode_Fat_Array | Type_Mode_Fat_Acc => declare - F : O_Fnode; Kind : Object_Kind_Type; begin Kind := Get_Object_Kind (Arr); - F := Info.T.Base_Field (Get_Object_Kind (Arr)); return Lp2M (New_Selected_Element (M2Lv (Arr), Info.T.Base_Field (Kind)), @@ -9364,7 +9333,7 @@ package body Translation is if Get_Info (Obj).Object_Static then return; end if; - if Get_Deferred_Declaration_Flag (Obj) = True then + if Get_Deferred_Declaration_Flag (Obj) then -- No code generation for a deferred constant. return; end if; @@ -9801,7 +9770,6 @@ package body Translation is (Decl : Iir; Parent : Iir; Check_Null : Boolean) is Sig_Type : Iir; - Type_Info : Type_Info_Acc; Name_Node : Mnode; Val : Iir; Data : Elab_Signal_Data; @@ -9812,7 +9780,6 @@ package body Translation is Open_Temp; Sig_Type := Get_Type (Decl); - Type_Info := Get_Info (Sig_Type); Base_Decl := Get_Base_Name (Decl); -- Set the name of the signal. @@ -10231,7 +10198,6 @@ package body Translation is Name : Iir; Name_Node : Mnode; Alias_Node : Mnode; - N_Info : Type_Info_Acc; Alias_Info : Alias_Info_Acc; Name_Type : Iir; Tinfo : Type_Info_Acc; @@ -10248,7 +10214,6 @@ package body Translation is Name_Type := Get_Type (Name); Name_Node := Chap6.Translate_Name (Name); Kind := Get_Object_Kind (Name_Node); - N_Info := Get_Info (Name_Type); case Tinfo.Type_Mode is when Type_Mode_Fat_Array => @@ -12086,13 +12051,11 @@ package body Translation is Open_Temp; declare Actual_Type : Iir; - Tinfo : Type_Info_Acc; Bounds : Mnode; Formal_Node : Mnode; begin Actual_Type := Get_Type (Get_Default_Value (Formal)); Chap3.Create_Array_Subtype (Actual_Type, True); - Tinfo := Get_Info (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Formal_Node := Chap6.Translate_Name (Formal); New_Assign_Stmt @@ -12104,13 +12067,11 @@ package body Translation is Open_Temp; declare Actual_Type : Iir; - Tinfo : Type_Info_Acc; Bounds : Mnode; Formal_Node : Mnode; begin Actual_Type := Get_Actual_Type (Assoc); Chap3.Create_Array_Subtype (Actual_Type, False); - Tinfo := Get_Info (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Formal_Node := Chap6.Translate_Name (Formal); New_Assign_Stmt @@ -12522,7 +12483,6 @@ package body Translation is Index : O_Enode; Index_Base_Type : Iir; Index_Range : Iir; - Index_Info : Type_Info_Acc; V : Iir_Int64; B : Iir_Int64; begin @@ -12539,8 +12499,6 @@ package body Translation is (New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (B))); else Index_Base_Type := Get_Base_Type (Index_Type); - Index_Info := Get_Info (Index_Base_Type); - Index := Chap7.Translate_Expression (Expr, Index_Base_Type); if Get_Direction (Index_Range) = Iir_To then @@ -12598,7 +12556,6 @@ package body Translation is Ibasetype : Iir; Prefix_Info : Type_Info_Acc; Nbr_Dim : Natural; - Fat_Ptr : O_Lnode; Range_Ptr : Mnode; begin Prefix_Type := Get_Type (Get_Prefix (Expr)); @@ -12610,7 +12567,6 @@ package body Translation is Prefix := Prefix_Orig; when Type_Mode_Ptr_Array => -- FIXME: should save the bounds address ? - Fat_Ptr := O_Lnode_Null; Prefix := Prefix_Orig; when others => raise Internal_Error; @@ -12725,7 +12681,6 @@ package body Translation is -- Type of the slice. Slice_Type : Iir; Slice_Info : Type_Info_Acc; - Slice_Binfo : Type_Info_Acc; -- Type of the first (and only) index of the prefix array type. Index_Type : Iir; @@ -12822,8 +12777,6 @@ package body Translation is Data.Is_Off := False; - Slice_Binfo := Get_Info (Get_Base_Type (Slice_Type)); - -- Save prefix. Prefix_Var := Stabilize (Prefix); @@ -12938,12 +12891,6 @@ package body Translation is (Prefix : Mnode; Expr : Iir_Slice_Name; Data : Slice_Name_Data) return Mnode is - -- Type of the prefix. - Prefix_Type : Iir; - - -- Type info of the prefix. - Prefix_Info : Type_Info_Acc; - -- Type of the slice. Slice_Type : Iir; Slice_Info : Type_Info_Acc; @@ -12956,11 +12903,9 @@ package body Translation is begin -- Evaluate the prefix. Slice_Type := Get_Type (Expr); - Prefix_Type := Get_Type (Get_Prefix (Expr)); Kind := Get_Object_Kind (Prefix); - Prefix_Info := Get_Info (Prefix_Type); Slice_Info := Get_Info (Slice_Type); if Data.Is_Off then @@ -14150,14 +14095,12 @@ package body Translation is is Res : O_Dnode; Type_Info : Type_Info_Acc; - Expr_Type_Info : Type_Info_Acc; begin -- FIXME: to do. -- Be sure the bounds variable was created. -- This may be necessary for on-the-fly types, such as strings. Chap3.Create_Array_Subtype (Expr_Type, True); - Expr_Type_Info := Get_Info (Expr_Type); Type_Info := Get_Info (Atype); Res := Create_Temp (Type_Info.Ortho_Type (Kind)); New_Assign_Stmt @@ -14372,7 +14315,6 @@ package body Translation is Res : O_Dnode; Res_Type : O_Tnode; If_Blk : O_If_Block; - Op : ON_Op_Kind; Val : Integer; V : O_Cnode; Kind : Iir_Predefined_Functions; @@ -14391,22 +14333,18 @@ package body Translation is case Kind is when Iir_Predefined_Bit_And | Iir_Predefined_Boolean_And => - Op := ON_And; Invert := False; Val := 1; when Iir_Predefined_Bit_Nand | Iir_Predefined_Boolean_Nand => - Op := ON_And; Invert := True; Val := 1; when Iir_Predefined_Bit_Or | Iir_Predefined_Boolean_Or => - Op := ON_Or; Invert := False; Val := 0; when Iir_Predefined_Bit_Nor | Iir_Predefined_Boolean_Nor => - Op := ON_Or; Invert := True; Val := 0; when others => @@ -15292,10 +15230,10 @@ package body Translation is procedure Translate_Record_Aggregate (Target : Mnode; Aggr : Iir) is Targ : Mnode; - Aggr_Type : Iir := Get_Type (Aggr); - Aggr_Base_Type : Iir_Record_Type_Definition := + Aggr_Type : constant Iir := Get_Type (Aggr); + Aggr_Base_Type : constant Iir_Record_Type_Definition := Get_Base_Type (Aggr_Type); - Nbr_El : Iir_Index32 := + Nbr_El : constant Iir_Index32 := Get_Number_Element_Declaration (Aggr_Base_Type); -- Record which elements of the record have been set. The 'others' @@ -15360,7 +15298,6 @@ package body Translation is Bounds : Mnode; Var_Index : O_Dnode; Targ : Mnode; - Tinfo : Type_Info_Acc; Range_Ptr : Mnode; Rinfo : Type_Info_Acc; @@ -15400,7 +15337,6 @@ package body Translation is If_Blk : O_If_Block; Op : ON_Op_Kind; begin - Tinfo := Get_Info (Target_Type); Open_Temp; Targ := Stabilize (Target); Base := Stabilize (Chap3.Get_Array_Base (Targ)); @@ -16034,7 +15970,6 @@ package body Translation is declare Unit : Iir; Unit_Info : Object_Info_Acc; - Unit_Type : Type_Info_Acc; begin Unit := Get_Unit_Name (Expr); Unit_Info := Get_Info (Unit); @@ -16043,7 +15978,6 @@ package body Translation is (Translate_Static_Expression (Expr, Rtype)); else -- Time units might be not locally static. - Unit_Type := Get_Info (Expr_Type); return New_Dyadic_Op (ON_Mul_Ov, New_Lit (New_Signed_Literal @@ -16057,7 +15991,6 @@ package body Translation is declare Unit : Iir; Unit_Info : Object_Info_Acc; - Unit_Type : Type_Info_Acc; L, R : O_Enode; begin Unit := Get_Unit_Name (Expr); @@ -16067,7 +16000,6 @@ package body Translation is (Translate_Static_Expression (Expr, Rtype)); else -- Time units might be not locally static. - Unit_Type := Get_Info (Expr_Type); L := New_Lit (New_Float_Literal (Ghdl_Real_Type, IEEE_Float_64 (Get_Fp_Value (Expr)))); @@ -16207,11 +16139,9 @@ package body Translation is | Iir_Kind_Attribute_Value => declare L : Mnode; - Expr_Type_Info : Type_Info_Acc; begin L := Chap6.Translate_Name (Expr); - Expr_Type_Info := Get_Info (Expr_Type); Res := M2E (L); if Get_Object_Kind (L) = Mode_Signal then Res := Translate_Signal (Res, Expr_Type); @@ -19406,7 +19336,6 @@ package body Translation is is Constr : O_Assoc_List; Conv_Info : Subprg_Info_Acc; - Res_Info : Type_Info_Acc; Res : O_Dnode; Imp : Iir; begin @@ -19441,7 +19370,6 @@ package body Translation is New_Association (Constr, M2E (Src)); - Res_Info := Get_Info (Get_Return_Type (Imp)); if Conv_Info.Res_Interface /= O_Dnode_Null then -- Composite result. New_Procedure_Call (Constr); @@ -19464,8 +19392,9 @@ package body Translation is is type Mnode_Array is array (Natural range <>) of Mnode; type O_Enode_Array is array (Natural range <>) of O_Enode; - Assoc_Chain : Iir := Get_Parameter_Association_Chain (Stmt); - Nbr_Assoc : Natural := Iir_Chains.Get_Chain_Length (Assoc_Chain); + Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt); + Nbr_Assoc : constant Natural := + Iir_Chains.Get_Chain_Length (Assoc_Chain); Params : Mnode_Array (0 .. Nbr_Assoc - 1); E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1); Imp : Iir; @@ -19480,7 +19409,6 @@ package body Translation is Base_Formal : Iir; Formal_Type : Iir; Ftype_Info : Type_Info_Acc; - Atype_Info : Type_Info_Acc; Formal_Info : Ortho_Info_Acc; Val : O_Enode; Param : Mnode; @@ -19592,7 +19520,6 @@ package body Translation is | Iir_Kind_Signal_Interface_Declaration => Param := Chap6.Translate_Name (Act); -- Atype may not have been set (eg: slice). - Atype_Info := Get_Info (Actual_Type); if Base_Formal /= Formal then Stabilize (Param); Params (Pos) := Param; @@ -20697,6 +20624,7 @@ package body Translation is when Iir_Kind_Procedure_Call_Statement => declare Assocs : Iir; + pragma Unreferenced (Assocs); -- FIXME Call : Iir_Procedure_Call; Imp : Iir; begin @@ -20752,8 +20680,8 @@ package body Translation is package body Chap9 is procedure Set_Direct_Drivers (Proc : Iir) is - Proc_Info : Proc_Info_Acc := Get_Info (Proc); - Drivers : Direct_Drivers_Acc := Proc_Info.Process_Drivers; + Proc_Info : constant Proc_Info_Acc := Get_Info (Proc); + Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers; Info : Ortho_Info_Acc; Var : Var_Acc; Sig : Iir; @@ -20777,8 +20705,8 @@ package body Translation is procedure Reset_Direct_Drivers (Proc : Iir) is - Proc_Info : Proc_Info_Acc := Get_Info (Proc); - Drivers : Direct_Drivers_Acc := Proc_Info.Process_Drivers; + Proc_Info : constant Proc_Info_Acc := Get_Info (Proc); + Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers; Info : Ortho_Info_Acc; Var : Var_Acc; Sig : Iir; @@ -21640,7 +21568,7 @@ package body Translation is end if; end Get_Arch_Name; - Str : String := + Str : constant String := Image_Identifier (Get_Library (Get_Design_File (Entity_Unit))) & "__" & Image_Identifier (Entity) & "__" & Get_Arch_Name & "__"; @@ -23260,28 +23188,22 @@ package body Translation is return Translate_Low_High_Type_Attribute (Atype, True); end Translate_Low_Type_Attribute; - function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode - is - Info : Type_Info_Acc; + function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode is begin if Get_Type_Staticness (Atype) = Locally then return New_Lit (Chap7.Translate_Static_Range_Left (Get_Range_Constraint (Atype), Atype)); else - Info := Get_Info (Atype); return M2E (Chap3.Range_To_Left (Chap3.Type_To_Range (Atype))); end if; end Translate_Left_Type_Attribute; - function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode - is - Info : Type_Info_Acc; + function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode is begin if Get_Type_Staticness (Atype) = Locally then return New_Lit (Chap7.Translate_Static_Range_Right (Get_Range_Constraint (Atype), Atype)); else - Info := Get_Info (Atype); return M2E (Chap3.Range_To_Right (Chap3.Type_To_Range (Atype))); end if; end Translate_Right_Type_Attribute; @@ -25149,8 +25071,9 @@ package body Translation is end if; declare - Lit_List : Iir_List := Get_Enumeration_Literal_List (Atype); - Nbr_Lit : Integer := Get_Nbr_Elements (Lit_List); + Lit_List : constant Iir_List := + Get_Enumeration_Literal_List (Atype); + Nbr_Lit : constant Integer := Get_Nbr_Elements (Lit_List); Lit : Iir; type Dnode_Array is array (Natural range <>) of O_Dnode; @@ -25491,6 +25414,7 @@ package body Translation is Nbr_Indexes : Integer; Index : Iir; Tmp : O_Dnode; + pragma Unreferenced (Tmp); Arr_Type : O_Tnode; Arr_Aggr : O_Array_Aggr_List; Val : O_Cnode; @@ -25563,6 +25487,7 @@ package body Translation is declare Mark : Id_Mark_Type; El_Rti : O_Dnode; + pragma Unreferenced (El_Rti); begin Push_Identifier_Prefix (Mark, "EL"); El_Rti := Generate_Type_Definition (Element); @@ -25603,6 +25528,7 @@ package body Translation is Aggr : O_Record_Aggr_List; Val : O_Cnode; Base_Rti : O_Dnode; + pragma Unreferenced (Base_Rti); Bounds : Var_Acc; Name : O_Dnode; Kind : O_Cnode; @@ -25950,6 +25876,7 @@ package body Translation is declare Mark : Id_Mark_Type; Tmp : O_Dnode; + pragma Unreferenced (Tmp); begin Push_Identifier_Prefix (Mark, "OT"); Tmp := Generate_Type_Definition (Decl_Type); @@ -27015,7 +26942,6 @@ package body Translation is -- Generic pointer. Ghdl_Ptr_Type := New_Access_Type (Char_Type_Node); - Const_Ptr_Type_Node := Ghdl_Ptr_Type; New_Type_Decl (Get_Identifier ("__ghdl_ptr"), Ghdl_Ptr_Type); -- Create record @@ -28252,6 +28178,7 @@ package body Translation is is Lib_Mark, Unit_Mark : Id_Mark_Type; Info : Ortho_Info_Acc; + pragma Unreferenced (Info); begin Update_Node_Infos; @@ -28518,6 +28445,7 @@ package body Translation is procedure Gen_Setup_Info is Cst : O_Dnode; + pragma Unreferenced (Cst); begin Cst := Create_String (Flags.Flag_String, Get_Identifier ("__ghdl_flag_string"), @@ -28831,6 +28759,7 @@ package body Translation is F : FILEs; R : int; S : size_t; + pragma Unreferenced (R, S); -- FIXME Id : Name_Id; Lib : Iir_Library_Declaration; File : Iir_Design_File; |