diff options
Diffstat (limited to 'translate')
54 files changed, 589 insertions, 476 deletions
diff --git a/translate/Makefile b/translate/Makefile index 32128c439..1fb63e5be 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 0139c2c76..308f400ae 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 46d347816..58c8ba5af 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 97dff900f..da78ff039 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 9e9e1e071..0d76bc502 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 a3895f9a0..4dcd208fa 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 52b7e5aa3..9de01b4ee 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 fb8f5f6d0..6565f9dce 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 0f4392926..b77ceca01 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 45750efeb..3dc555044 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 4bae12dce..f60504ac0 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 ff68bc7b0..1c6af4d10 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 b82e33b7d..3fc736161 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 ee264cf3e..b34744f7a 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 36826fe14..a5c36e598 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 33fb36cef..6750e7d03 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 075c8b4dc..3a6b3e74c 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 dded64430..c92677564 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 e9011c989..85acb93a0 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 e4f55f3d1..3f337ab35 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 627316119..5b541af1e 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 6da675d1b..a1ce0ceb2 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 1fcce3cd4..b87478042 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 5f8a081f9..d6efba0c3 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 74a7bd7e9..0d7224b30 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 0d1507ff0..dcddcf29b 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 86a388cd6..43166fa0a 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 6fe8eea32..cb43711a0 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 46ed04e2d..8afe1bca0 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 0cb515e97..a272246be 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 650c0f005..058e8a57b 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 2ef0653c5..a3a2cf0d3 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 84d7c3a5c..4488654d5 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 4fd558e3d..18a5dfe05 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 b56401739..fbf9f3e8c 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 77a453ba3..505b28198 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 aca2744a3..d16e88716 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 973d61766..13a939aac 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 000000000..f570b40ca --- /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 000000000..528d73b4a --- /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 668e9b71f..3197e2cce 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 2f244e643..0f8f48a23 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 f7aa0d8d0..bf1842da2 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 a6d79b402..1079e90a4 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 a6ba718e3..aec35a8d7 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 5c8c1d0e8..2e7987ca5 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 f1a8b0255..6c1d3a6b5 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 2af34a237..ff311be7b 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 d17cc87ea..bb62d28ca 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 c2c01387a..fc109500e 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 54b06c05d..586a54ebc 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 a6d5619d9..43d7508a1 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 13b82fcab..0725fb727 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 72d45774b..fb269abd5 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; |