diff options
Diffstat (limited to 'translate/ghdldrv')
| -rw-r--r-- | translate/ghdldrv/Makefile | 10 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlcomp.adb | 14 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdldrv.adb | 86 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdllocal.adb | 35 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlmain.adb | 3 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlprint.adb | 28 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 19 |
7 files changed, 84 insertions, 111 deletions
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 9e9e1e0..0d76bc5 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -15,9 +15,11 @@ # along with GCC; see the file COPYING. If not, write to the Free # Software Foundation, 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. -GNATFLAGS=-gnaty3befhkmr -gnata -gnatwu -gnatwl -aI../.. -aI.. -aI../grt -aO.. -g -gnatf +GNATFLAGS=-gnaty3befhkmr -gnata -gnatwae -aI../.. -aI.. -aI../grt -aO.. -g -gnatf GRT_FLAGS=-g LIB_CFLAGS=-g -O2 +GNATMAKE=gnatmake +CC=gcc # Optimize, do not forget to use MODE=--genfast for iirs.adb. #GNATFLAGS+=-O -gnatn @@ -52,13 +54,13 @@ ortho_code-x86-flags.ads: ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force - gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) + $(GNATMAKE) -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) -largs -L/usr/lib32 memsegs_c.o: ../../ortho/mcode/memsegs_c.c $(CC) -c -g -o $@ $< ghdl_gcc: default_pathes.ads force - gnatmake $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS) + $(GNATMAKE) $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS) ghdl_simul: default_pathes.ads force gnatmake -aI../../simulate $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) @@ -116,7 +118,7 @@ install.v87: std.v87 ieee.v87 synopsys.v87 install.standard: $(LIB93_DIR)/std/std_standard.o \ $(LIB87_DIR)/std/std_standard.o -make-lib-links: +grt.links: cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver . install.all: install.v87 install.v93 install.standard diff --git a/translate/ghdldrv/ghdlcomp.adb b/translate/ghdldrv/ghdlcomp.adb index a3895f9..4dcd208 100644 --- a/translate/ghdldrv/ghdlcomp.adb +++ b/translate/ghdldrv/ghdlcomp.adb @@ -122,9 +122,6 @@ package body Ghdlcomp is end; Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last)); Hooks.Run.all; - exception - when Errorout.Option_Error => - raise; end Perform_Action; @@ -197,7 +194,7 @@ package body Ghdlcomp is Elab_Arg := Natural'Last; for I in Args'Range loop declare - Arg : String := Args (I).all; + Arg : constant String := Args (I).all; Res : Iir_Design_File; Design : Iir; Next_Design : Iir; @@ -246,9 +243,6 @@ package body Ghdlcomp is Error_Msg_Option ("options after unit are ignored"); end if; end if; - exception - when Errorout.Option_Error => - raise; end Perform_Action; -- Command -a @@ -346,8 +340,6 @@ package body Ghdlcomp is else raise; end if; - when Errorout.Option_Error => - raise; end Perform_Action; -- Command -e @@ -427,8 +419,6 @@ package body Ghdlcomp is else raise; end if; - when Errorout.Option_Error => - raise; end Perform_Action; -- Command dispconfig. @@ -636,7 +626,7 @@ package body Ghdlcomp is Put ("GHDLFLAGS="); for I in 2 .. Argument_Count loop declare - Arg : String := Argument (I); + Arg : constant String := Argument (I); begin if Arg (1) = '-' then if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=") diff --git a/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb index 52b7e5a..9de01b4 100644 --- a/translate/ghdldrv/ghdldrv.adb +++ b/translate/ghdldrv/ghdldrv.adb @@ -57,9 +57,6 @@ package body Ghdldrv is -- "-o" string. Dash_O : String_Access; - -- "-S" string. - Dash_S : String_Access; - -- "-quiet" option. Dash_Quiet : String_Access; @@ -155,7 +152,8 @@ package body Ghdldrv is -- Compile. declare P : Natural; - Nbr_Args : Natural := Last (Compiler_Args) + Options'Length + 4; + Nbr_Args : constant Natural := + Last (Compiler_Args) + Options'Length + 4; Args : Argument_List (1 .. Nbr_Args); begin P := 0; @@ -199,7 +197,7 @@ package body Ghdldrv is if Compile_Kind = Compile_Debug then declare P : Natural; - Nbr_Args : Natural := Last (Postproc_Args) + 4; + Nbr_Args : constant Natural := Last (Postproc_Args) + 4; Args : Argument_List (1 .. Nbr_Args); begin P := 0; @@ -229,7 +227,7 @@ package body Ghdldrv is elsif not Flag_Asm then declare P : Natural; - Nbr_Args : Natural := Last (Assembler_Args) + 4; + Nbr_Args : constant Natural := Last (Assembler_Args) + 4; Args : Argument_List (1 .. Nbr_Args); Success : Boolean; begin @@ -358,7 +356,6 @@ package body Ghdldrv is is use Files_Map; - Dir : Name_Id; Name : Name_Id; File : Source_File_Entry; @@ -368,7 +365,6 @@ package body Ghdldrv is return False; end if; - Dir := Get_Library_Directory (Get_Library (Design_File)); Name := Get_Design_File_Filename (Design_File); declare Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul; @@ -539,7 +535,6 @@ package body Ghdldrv is Tool_Not_Found (Linker_Cmd); end if; Dash_O := new String'("-o"); - Dash_S := new String'("-S"); Dash_Quiet := new String'("-quiet"); end Locate_Tools; @@ -596,88 +591,87 @@ package body Ghdldrv is Res : out Option_Res) is Str : String_Access; + Opt : constant String (1 .. Option'Length) := Option; begin Res := Option_Bad; - if Option = "-v" and then Flag_Verbose = False then + if Opt = "-v" and then Flag_Verbose = False then -- Note: this is also decoded for command_lib, but we set -- Flag_Disp_Commands too. Flag_Verbose := True; --Flags.Verbose := True; Flag_Disp_Commands := True; Res := Option_Ok; - elsif Option'Length > 8 and then Option (1 .. 8) = "--GHDL1=" then - Compiler_Cmd := new String'(Option (9 .. Option'Last)); + elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then + Compiler_Cmd := new String'(Opt (9 .. Opt'Last)); Res := Option_Ok; - elsif Option = "-S" then + elsif Opt = "-S" then Flag_Asm := True; Res := Option_Ok; - elsif Option = "--post" then + elsif Opt = "--post" then Compile_Kind := Compile_Debug; Res := Option_Ok; - elsif Option = "--mcode" then + elsif Opt = "--mcode" then Compile_Kind := Compile_Mcode; Res := Option_Ok; - elsif Option = "-o" then + elsif Opt = "-o" then if Arg'Length = 0 then Res := Option_Arg_Req; else Output_File := new String'(Arg); Res := Option_Arg; end if; - elsif Option = "-m32" then + elsif Opt = "-m32" then Add_Argument (Compiler_Args, new String'("-m32")); Add_Argument (Assembler_Args, new String'("--32")); Add_Argument (Linker_Args, new String'("-m32")); - Decode_Option (Command_Lib (Cmd), Option, Arg, Res); - elsif Option'Length > 4 - and then Option (2) = 'W' and then Option (4) = ',' + Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); + elsif Opt'Length > 4 + and then Opt (2) = 'W' and then Opt (4) = ',' then - if Option (3) = 'c' then - Add_Arguments (Compiler_Args, Option); - elsif Option (3) = 'a' then - Add_Arguments (Assembler_Args, Option); - elsif Option (3) = 'p' then - Add_Arguments (Postproc_Args, Option); - elsif Option (3) = 'l' then - Add_Arguments (Linker_Args, Option); + if Opt (3) = 'c' then + Add_Arguments (Compiler_Args, Opt); + elsif Opt (3) = 'a' then + Add_Arguments (Assembler_Args, Opt); + elsif Opt (3) = 'p' then + Add_Arguments (Postproc_Args, Opt); + elsif Opt (3) = 'l' then + Add_Arguments (Linker_Args, Opt); else Error - ("unknown tool name in '-W" & Option (3) & ",' option"); + ("unknown tool name in '-W" & Opt (3) & ",' option"); raise Option_Error; end if; Res := Option_Ok; - elsif Option'Length >= 2 and then Option (2) = 'g' then + elsif Opt'Length >= 2 and then Opt (2) = 'g' then -- Debugging option. - Str := new String'(Option); + Str := new String'(Opt); Add_Argument (Compiler_Args, Str); Add_Argument (Linker_Args, Str); Res := Option_Ok; - elsif Option = "-Q" then + elsif Opt = "-Q" then Flag_Not_Quiet := True; Res := Option_Ok; - elsif Option = "--expect-failure" then - Add_Argument (Compiler_Args, new String'(Option)); + elsif Opt = "--expect-failure" then + Add_Argument (Compiler_Args, new String'(Opt)); Flag_Expect_Failure := True; Res := Option_Ok; - elsif Flags.Parse_Option (Option) then - Add_Argument (Compiler_Args, new String'(Option)); + elsif Flags.Parse_Option (Opt) then + Add_Argument (Compiler_Args, new String'(Opt)); Res := Option_Ok; - elsif Option'Length >= 2 - and then (Option (2) = 'O' or Option (2) = 'f') + elsif Opt'Length >= 2 + and then (Opt (2) = 'O' or Opt (2) = 'f') then -- Optimization option. -- This is put after Flags.Parse_Option, since it may catch -fxxx -- options. - Add_Argument (Compiler_Args, new String'(Option)); + Add_Argument (Compiler_Args, new String'(Opt)); Res := Option_Ok; else - Decode_Option (Command_Lib (Cmd), Option, Arg, Res); + Decode_Option (Command_Lib (Cmd), Opt, Arg, Res); end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Comp) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Comp) is begin Disp_Long_Help (Command_Lib (Cmd)); Put_Line (" -v Be verbose"); @@ -719,7 +713,6 @@ package body Ghdldrv is procedure Perform_Action (Cmd : in out Command_Dispconfig; Args : Argument_List) is - use Ada.Text_IO; use Libraries; pragma Unreferenced (Cmd); begin @@ -912,7 +905,7 @@ package body Ghdldrv is -- call the linker declare P : Natural; - Nbr_Args : Natural := Last (Linker_Args) + Filelist.Last + 4; + Nbr_Args : constant Natural := Last (Linker_Args) + Filelist.Last + 4; Args : Argument_List (1 .. Nbr_Args); Obj_File : String_Access; Std_File : String_Access; @@ -997,6 +990,7 @@ package body Ghdldrv is is pragma Unreferenced (Cmd); Success : Boolean; + pragma Unreferenced (Success); begin Set_Elab_Units ("-e", Args); Setup_Compiler (False); @@ -1614,7 +1608,7 @@ package body Ghdldrv is Put ("GHDLFLAGS="); for I in 2 .. Argument_Count loop declare - Arg : String := Argument (I); + Arg : constant String := Argument (I); begin if Arg (1) = '-' then if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=") diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index fb8f5f6..6565f9d 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; -with Ghdlmain; with Types; use Types; with Libraries; with Std_Package; @@ -40,7 +39,7 @@ package body Ghdllocal is type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor); Flag_Ieee : Ieee_Lib_Kind; - Flag_Create_Default_Config : Boolean := True; + Flag_Create_Default_Config : constant Boolean := True; -- If TRUE, generate 32bits code on 64bits machines. Flag_32bit : Boolean := False; @@ -108,36 +107,37 @@ package body Ghdllocal is is pragma Unreferenced (Cmd); pragma Unreferenced (Arg); + Opt : constant String (1 .. Option'Length) := Option; begin Res := Option_Bad; - if Option = "-v" and then Flag_Verbose = False then + if Opt = "-v" and then Flag_Verbose = False then Flag_Verbose := True; Res := Option_Ok; - elsif Option'Length > 9 and then Option (1 .. 9) = "--PREFIX=" then - Prefix_Path := new String'(Option (10 .. Option'Last)); + elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then + Prefix_Path := new String'(Opt (10 .. Opt'Last)); Res := Option_Ok; - elsif Option = "--ieee=synopsys" then + elsif Opt = "--ieee=synopsys" then Flag_Ieee := Lib_Synopsys; Res := Option_Ok; - elsif Option = "--ieee=mentor" then + elsif Opt = "--ieee=mentor" then Flag_Ieee := Lib_Mentor; Res := Option_Ok; - elsif Option = "--ieee=none" then + elsif Opt = "--ieee=none" then Flag_Ieee := Lib_None; Res := Option_Ok; - elsif Option = "--ieee=standard" then + elsif Opt = "--ieee=standard" then Flag_Ieee := Lib_Standard; Res := Option_Ok; - elsif Option = "-m32" then + elsif Opt = "-m32" then Flag_32bit := True; Res := Option_Ok; - elsif Option'Length >= 2 - and then (Option (2) = 'g' or Option (2) = 'O') + elsif Opt'Length >= 2 + and then (Opt (2) = 'g' or Opt (2) = 'O') then -- Silently accept -g and -O. Res := Option_Ok; else - if Flags.Parse_Option (Option) then + if Flags.Parse_Option (Opt) then Res := Option_Ok; end if; end if; @@ -326,7 +326,7 @@ package body Ghdllocal is function Append_Suffix (File : String; Suffix : String) return String_Access is use Name_Table; - Basename : String := Get_Base_Name (File); + Basename : constant String := Get_Base_Name (File); begin Image (Libraries.Work_Directory); Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) := @@ -429,7 +429,7 @@ package body Ghdllocal is Design_File : Iir_Design_File; Unit : Iir; Lib : Iir; - Flag_Add : Boolean := False; + Flag_Add : constant Boolean := False; begin Flags.Bootstrap := True; Libraries.Load_Std_Library; @@ -646,7 +646,6 @@ package body Ghdllocal is procedure Delete (Str : String) is - use GNAT.OS_Lib; use Ada.Text_IO; Status : Boolean; begin @@ -659,7 +658,6 @@ package body Ghdllocal is procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List) is pragma Unreferenced (Cmd); - use GNAT.OS_Lib; use Name_Table; procedure Delete_Asm_Obj (Str : String) is @@ -805,6 +803,7 @@ package body Ghdllocal is procedure Extract_Library_Clauses (Unit : Iir_Design_Unit) is Lib1 : Iir_Library_Declaration; + pragma Unreferenced (Lib1); Ctxt_Item : Iir; begin -- Extract library clauses. @@ -1059,7 +1058,7 @@ package body Ghdllocal is if Args'Length >= 2 then declare - Sec : String_Access := Args (Next_Arg); + Sec : constant String_Access := Args (Next_Arg); begin if Sec (Sec'First) /= '-' then Sec_Name := Convert_Name (Sec); diff --git a/translate/ghdldrv/ghdlmain.adb b/translate/ghdldrv/ghdlmain.adb index 0f43929..b77ceca 100644 --- a/translate/ghdldrv/ghdlmain.adb +++ b/translate/ghdldrv/ghdlmain.adb @@ -20,7 +20,6 @@ with Ada.Command_Line; with Version; with Flags; with Bug; -with Errorout; package body Ghdlmain is procedure Init (Cmd : in out Command_Type) @@ -275,7 +274,7 @@ package body Ghdlmain is Arg_Index := 2; while Arg_Index <= Argument_Count loop declare - Arg : String := Argument (Arg_Index); + Arg : constant String := Argument (Arg_Index); Res : Option_Res; begin if Arg (1) = '-' then diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb index 45750ef..3dc5550 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -84,9 +84,6 @@ package body Ghdlprint is Buf : File_Buffer_Acc; Prev_Tok : Token_Type; - -- True if tokens are between 'end' and ';' - In_End : Boolean := False; - -- Current logical column number. Used to expand TABs. Col : Natural; @@ -372,9 +369,7 @@ package body Ghdlprint is Disp_Reserved; when Tok_End => Disp_Reserved; - In_End := True; when Tok_Semi_Colon => - In_End := False; Disp_Spaces; Disp_Text; when Tok_Xnor .. Tok_Ror => @@ -944,9 +939,7 @@ package body Ghdlprint is end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Html) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Html) is begin Disp_Long_Help (Command_Lib (Cmd)); Put_Line ("--format=html2 Use FONT attributes"); @@ -1068,9 +1061,7 @@ package body Ghdlprint is end if; end Decode_Option; - procedure Disp_Long_Help (Cmd : Command_Xref_Html) - is - use Ada.Text_IO; + procedure Disp_Long_Help (Cmd : Command_Xref_Html) is begin Disp_Long_Help (Command_Html (Cmd)); Put_Line ("-o DIR Put generated files into DIR (def: html/)"); @@ -1115,7 +1106,6 @@ package body Ghdlprint is Files : File_Data_Array; Output : File_Type; - Prev_Output : File_Access; begin Xrefs.Init; Flags.Flag_Xref := True; @@ -1220,8 +1210,6 @@ package body Ghdlprint is Filexref_Info (Files (I).Fe).Output := Files (I).Output; end loop; - Prev_Output := Current_Input; - for I in Files'Range loop if Cmd.Output_Dir /= null then Create (Output, Out_File, @@ -1304,7 +1292,7 @@ package body Ghdlprint is and then Cmd.Output_Dir /= null then declare - Css_Filename : String := + Css_Filename : constant String := Cmd.Output_Dir.all & Directory_Separator & "ghdl.css"; begin if not Is_Regular_File (Css_Filename & Nul) then @@ -1427,6 +1415,7 @@ package body Ghdlprint is Loc_File : Source_File_Entry; Loc_Pos : Source_Ptr; C : Character; + Dir : Name_Id; begin New_Line; Cur_Decl := N; @@ -1435,8 +1424,11 @@ package body Ghdlprint is if Loc_File /= Cur_File then Cur_File := Loc_File; Put ("XFILE: "); - Image (Get_Source_File_Directory (Cur_File)); - Put (Name_Buffer (1 .. Name_Length)); + Dir := Get_Source_File_Directory (Cur_File); + if Dir /= Null_Identifier then + Image (Dir); + Put (Name_Buffer (1 .. Name_Length)); + end if; Image (Get_File_Name (Cur_File)); Put (Name_Buffer (1 .. Name_Length)); New_Line; @@ -1537,8 +1529,6 @@ package body Ghdlprint is Emit_Ref (I, 'r'); when Xref_Body => Emit_Ref (I, 'b'); - when others => - null; end case; end if; end loop; diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index 4bae12d..f60504a 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -29,7 +29,6 @@ with Binary_File; use Binary_File; with Binary_File.Memory; with Ortho_Mcode; use Ortho_Mcode; with Ortho_Code.Flags; use Ortho_Code.Flags; -with Binary_File; with Interfaces; with System; use System; with Trans_Decls; @@ -46,7 +45,6 @@ with Trans_Be; with Translation; with Std_Names; with Ieee.Std_Logic_1164; -with Interfaces.C; with Binary_File.Elf; @@ -250,8 +248,9 @@ package body Ghdlrun is case Info.Kind is when Foreign_Vhpidirect => declare - Name : String := Name_Table.Name_Buffer (Info.Subprg_First - .. Info.Subprg_Last); + Name : constant String := + Name_Table.Name_Buffer (Info.Subprg_First + .. Info.Subprg_Last); begin Res := Foreigns.Find_Foreign (Name); if Res /= Null_Address then @@ -270,7 +269,6 @@ package body Ghdlrun is procedure Run is - use Binary_File; use Interfaces; use Ortho_Code.Binary; @@ -632,15 +630,16 @@ package body Ghdlrun is function Decode_Option (Option : String) return Boolean is + Opt : constant String (1 .. Option'Length) := Option; begin - if Option = "-g" then + if Opt = "-g" then Flag_Debug := Debug_Dwarf; return True; - elsif Option'Length > 5 and then Option (1 .. 5) = "--be-" then - Ortho_Code.Debug.Set_Be_Flag (Option); + elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then + Ortho_Code.Debug.Set_Be_Flag (Opt); return True; - elsif Option'Length > 7 and then Option (1 .. 7) = "--snap=" then - Snap_Filename := new String'(Option (8 .. Option'Last)); + elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then + Snap_Filename := new String'(Opt (8 .. Opt'Last)); return True; else return False; |