diff options
| -rw-r--r-- | translate/ghdldrv/Makefile | 30 | ||||
| -rw-r--r-- | translate/ghdldrv/default_pathes.ads.in | 2 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdl_gcc.adb | 1 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdldrv.adb | 61 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdldrv.ads | 5 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdllocal.adb | 8 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdllocal.ads | 3 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlprint.adb | 2 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 105 |
9 files changed, 113 insertions, 104 deletions
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 66e0abd..7aa2cdb 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -29,12 +29,18 @@ CC=gcc #GNATFLAGS+=-pg -gnatn -O #GRT_FLAGS+=-pg -O +# Coverage +#GNATFLAGS+=-fprofile-arcs -ftest-coverage + GNAT_BARGS=-bargs -E +LLVM_CONFIG=llvm-config + #GNAT_LARGS= -static all: ghdl_mcode target=i686-pc-linux-gnu +#target=x86_64-pc-linux-gnu GRTSRCDIR=../grt include $(GRTSRCDIR)/Makefile.inc @@ -54,14 +60,24 @@ 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)) -largs -L/usr/lib32 + $(GNATMAKE) -aI../../ortho/mcode -aI../../ortho $(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 + +ghdl_llvm_jit: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME +ghdl_llvm_jit: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) bindings.o force + $(GNATMAKE) -o $@ -aI../../ortho/llvm -aI../../ortho/mcode -aI../../ortho $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs -m64 bindings.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) --LINK=g++ memsegs_c.o: ../../ortho/mcode/memsegs_c.c $(CC) -c -g -o $@ $< +bindings.o: ../../ortho/llvm/bindings.cpp + $(CXX) -c -m64 `$(LLVM_CONFIG) --cxxflags` -g -o $@ $< + ghdl_gcc: default_pathes.ads force $(GNATMAKE) $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS) +ghdl_llvm: default_pathes.ads force + $(GNATMAKE) $(GNATFLAGS) ghdl_llvm $(GNAT_BARGS) -largs $(GNAT_LARGS) + ghdl_simul: default_pathes.ads force gnatmake -aI../../simulate $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) @@ -70,6 +86,7 @@ default_pathes.ads: default_pathes.ads.in Makefile sed -e "s%@COMPILER_GCC@%$$curdir/ghdl1-gcc%" \ -e "s%@COMPILER_DEBUG@%$$curdir/ghdl1-debug%" \ -e "s%@COMPILER_MCODE@%$$curdir/ghdl1-mcode%" \ + -e "s%@COMPILER_LLVM@%$$curdir/ghdl1-llvm%" \ -e "s%@POST_PROCESSOR@%$$curdir/../ortho/oread/oread-gcc%" \ -e "s%@PREFIX@%$$curdir/lib/%" < $< > $@ @@ -110,6 +127,13 @@ $(LIB87_DIR)/std/std_standard.o: $(GHDL1) $(CC) -c -o $@ std_standard.s $(RM) std_standard.s +GHDL1LLVM=../ghdl1-llvm +$(LIB93_DIR)/std/std_standard.bc: $(GHDL1LLVM) + $(GHDL1LLVM) --std=93 -o $@ --compile-standard + +$(LIB87_DIR)/std/std_standard.bc: $(GHDL1LLVM) + $(GHDL1LLVM) --std=87 -o $@ --compile-standard + install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93 install.v87: std.v87 ieee.v87 synopsys.v87 install.v08: std.v08 @@ -117,11 +141,15 @@ install.v08: std.v08 install.standard: $(LIB93_DIR)/std/std_standard.o \ $(LIB87_DIR)/std/std_standard.o +install.standard-llvm: $(LIB93_DIR)/std/std_standard.bc \ + $(LIB87_DIR)/std/std_standard.bc + 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 install.mcode: install.v87 install.v93 install.v08 +install.llvm: install.standard-llvm clean: force $(RM) -f *.o *.ali ghdl_gcc ghdl_mcode diff --git a/translate/ghdldrv/default_pathes.ads.in b/translate/ghdldrv/default_pathes.ads.in index 3808595..8d101fd 100644 --- a/translate/ghdldrv/default_pathes.ads.in +++ b/translate/ghdldrv/default_pathes.ads.in @@ -19,6 +19,8 @@ package Default_Pathes is Compiler_Mcode : constant String := "@COMPILER_MCODE@"; + Compiler_Llvm : constant String := + "@COMPILER_LLVM@"; Compiler_Gcc : constant String := "@COMPILER_GCC@"; Compiler_Debug : constant String := diff --git a/translate/ghdldrv/ghdl_gcc.adb b/translate/ghdldrv/ghdl_gcc.adb index a93579b..615a8c5 100644 --- a/translate/ghdldrv/ghdl_gcc.adb +++ b/translate/ghdldrv/ghdl_gcc.adb @@ -25,6 +25,7 @@ begin -- Manual elaboration so that the order is known (because it is the order -- used to display help). Ghdlmain.Version_String := new String'("GCC back-end code generator"); + Ghdldrv.Compile_Kind := Ghdldrv.Compile_Gcc; Ghdldrv.Register_Commands; Ghdllocal.Register_Commands; Ghdlprint.Register_Commands; diff --git a/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb index b21d633..438227d 100644 --- a/translate/ghdldrv/ghdldrv.adb +++ b/translate/ghdldrv/ghdldrv.adb @@ -44,6 +44,7 @@ package body Ghdldrv is Post_Processor_Cmd : String_Access := null; Assembler_Cmd : constant String := "as"; Linker_Cmd : constant String := "gcc"; + Llvm_Linker_Cmd : constant String := "llvm-ld"; -- Path of the tools. Compiler_Path : String_Access; @@ -61,8 +62,6 @@ package body Ghdldrv is -- "-quiet" option. Dash_Quiet : String_Access; - type Compile_Kind_Type is (Compile_Mcode, Compile_Gcc, Compile_Debug); - Compile_Kind : Compile_Kind_Type := Compile_Gcc; -- If set, do not assmble Flag_Asm : Boolean; @@ -140,6 +139,8 @@ package body Ghdldrv is when Compile_Gcc | Compile_Debug => Asm_File := Append_Suffix (File, Asm_Suffix); + when Compile_Llvm => + Asm_File := Append_Suffix (File, Llvm_Suffix); when Compile_Mcode => null; end case; @@ -177,7 +178,8 @@ package body Ghdldrv is case Compile_Kind is when Compile_Debug => Args (P + 2) := Post_File; - when Compile_Gcc => + when Compile_Gcc + | Compile_Llvm => Args (P + 2) := Asm_File; when Compile_Mcode => Args (P + 2) := Obj_File; @@ -258,6 +260,8 @@ package body Ghdldrv is Table_Initial => 16, Table_Increment => 100); + Link_Obj_Suffix : String_Access; + -- Read a list of files from file FILENAME. -- Lines starting with a '#' are ignored (comments) -- Lines starting with a '>' are directory lines @@ -298,7 +302,7 @@ package body Ghdldrv is Stream := fopen (Line'Address, Mode'Address); if Stream = NULL_Stream then Error ("cannot open " & Filename); - return; + raise Compile_Error; end if; Dir_Len := 0; loop @@ -322,7 +326,7 @@ package body Ghdldrv is if To_Obj then File := new String'(Dir (1 .. Dir_Len) & Get_Base_Name (Line (1 .. L)) - & Get_Object_Suffix.all); + & Link_Obj_Suffix.all); else File := new String'(Substitute (Line (1 .. L))); end if; @@ -505,6 +509,8 @@ package body Ghdldrv is Compiler_Cmd := new String'(Default_Pathes.Compiler_Gcc); when Compile_Mcode => Compiler_Cmd := new String'(Default_Pathes.Compiler_Mcode); + when Compile_Llvm => + Compiler_Cmd := new String'(Default_Pathes.Compiler_Llvm); end case; end if; if Post_Processor_Cmd = null then @@ -531,9 +537,16 @@ package body Ghdldrv is Tool_Not_Found (Assembler_Cmd); end if; end if; - Linker_Path := Locate_Exec_On_Path (Linker_Cmd); - if Linker_Path = null then - Tool_Not_Found (Linker_Cmd); + if Compile_Kind = Compile_Llvm then + Linker_Path := Locate_Exec_On_Path (Llvm_Linker_Cmd); + if Linker_Path = null then + Tool_Not_Found (Llvm_Linker_Cmd); + end if; + else + Linker_Path := Locate_Exec_On_Path (Linker_Cmd); + if Linker_Path = null then + Tool_Not_Found (Linker_Cmd); + end if; end if; Dash_O := new String'("-o"); Dash_Quiet := new String'("-quiet"); @@ -574,7 +587,6 @@ package body Ghdldrv is Flag_Not_Quiet := False; Flag_Disp_Commands := False; Flag_Asm := False; - Compile_Kind := Compile_Gcc; Flag_Expect_Failure := False; Output_File := null; @@ -614,6 +626,9 @@ package body Ghdldrv is elsif Opt = "--mcode" then Compile_Kind := Compile_Mcode; Res := Option_Ok; + elsif Opt = "--llvm" then + Compile_Kind := Compile_Llvm; + Res := Option_Ok; elsif Opt = "-o" then if Arg'Length = 0 then Res := Option_Arg_Req; @@ -895,7 +910,21 @@ package body Ghdldrv is Disp_Only : Boolean) is Last_File : Natural; + Final_Output_File : String_Access; begin + case Compile_Kind is + when Compile_Llvm => + Link_Obj_Suffix := new String'(Llvm_Suffix); + -- Hacks for llvm: + -- 1. Generate a native executable. + Add_Argument (Linker_Args, new String'("-native")); + -- 2. Use an intermediate file. + Final_Output_File := Output_File; + Output_File := new String'(Output_File.all & "~e"); + when others => + Link_Obj_Suffix := Get_Object_Suffix; + end case; + -- read files list if Filelist_Name /= null then Add_File_List (Filelist_Name.all, True); @@ -910,9 +939,9 @@ package body Ghdldrv is Args : Argument_List (1 .. Nbr_Args); Obj_File : String_Access; Std_File : String_Access; + Status : Boolean; begin - Obj_File := Append_Suffix - (Elab_Name.all, Get_Object_Suffix.all); + Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all); P := 0; Args (P + 1) := Dash_O; Args (P + 2) := Output_File; @@ -923,7 +952,7 @@ package body Ghdldrv is String'(Get_Machine_Path_Prefix & Get_Version_Path & Directory_Separator & "std" & Directory_Separator - & "std_standard" & Get_Object_Suffix.all); + & "std_standard" & Link_Obj_Suffix.all); P := P + 1; Args (P) := Std_File; else @@ -953,6 +982,14 @@ package body Ghdldrv is end loop; else My_Spawn (Linker_Path.all, Args (1 .. P)); + if Compile_Kind = Compile_Llvm then + Rename_File (Output_File.all, Final_Output_File.all, Status); + if not Status then + raise Compile_Error; + end if; + Free (Output_File); + Output_File := Final_Output_File; + end if; end if; Free (Obj_File); diff --git a/translate/ghdldrv/ghdldrv.ads b/translate/ghdldrv/ghdldrv.ads index 05b0856..3e37b38 100644 --- a/translate/ghdldrv/ghdldrv.ads +++ b/translate/ghdldrv/ghdldrv.ads @@ -16,5 +16,10 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. package Ghdldrv is + -- Compiler to use. + type Compile_Kind_Type is + (Compile_Mcode, Compile_Llvm, Compile_Gcc, Compile_Debug); + Compile_Kind : Compile_Kind_Type := Compile_Gcc; + procedure Register_Commands; end Ghdldrv; diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index 5cd97b4..7f6149a 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -53,6 +53,10 @@ package body Ghdllocal is Config : Iir_Design_Unit; Lib : Iir; begin + if (Main or Flags.Dump_All) and then Flags.Dump_Parse then + Disp_Tree.Disp_Tree (Unit); + end if; + if Flags.Verbose then Put_Line ("semantize " & Disp_Node (Get_Library_Unit (Unit))); end if; @@ -67,6 +71,10 @@ package body Ghdllocal is raise Compilation_Error; end if; + if (Main or Flags.List_All) and then Flags.List_Sem then + Disp_Vhdl.Disp_Vhdl (Unit); + end if; + Post_Sems.Post_Sem_Checks (Unit); if Errorout.Nbr_Errors > 0 then diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads index f55503a..46eff1a 100644 --- a/translate/ghdldrv/ghdllocal.ads +++ b/translate/ghdldrv/ghdllocal.ads @@ -41,6 +41,9 @@ package Ghdllocal is -- Suffix for asm files. Asm_Suffix : constant String := ".s"; + -- Suffix for llvm byte-code files. + Llvm_Suffix : constant String := ".bc"; + -- Suffix for post files. Post_Suffix : constant String := ".on"; diff --git a/translate/ghdldrv/ghdlprint.adb b/translate/ghdldrv/ghdlprint.adb index 7a95854..8947e64 100644 --- a/translate/ghdldrv/ghdlprint.adb +++ b/translate/ghdldrv/ghdlprint.adb @@ -947,7 +947,7 @@ package body Ghdlprint is Put_Line ("--format=css Use ghdl.css file"); end Disp_Long_Help; - -- Command --pp_html. + -- Command --pp-html. type Command_PP_Html is new Command_Html with null record; function Decode_Command (Cmd : Command_PP_Html; Name : String) return Boolean; diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index f60504a..4e13a4f 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -25,16 +25,11 @@ with Ada.Unchecked_Conversion; with Ada.Command_Line; with Ada.Text_IO; -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 Ortho_Jit; +with Ortho_Nodes; use Ortho_Nodes; with Interfaces; with System; use System; with Trans_Decls; -with Ortho_Code.Binary; -with Ortho_Code.Debug; -with Ortho_Code.Abi; with Types; with Iirs; use Iirs; with Flags; @@ -46,8 +41,6 @@ with Translation; with Std_Names; with Ieee.Std_Logic_1164; -with Binary_File.Elf; - with Lists; with Str_Table; with Nodes; @@ -71,8 +64,6 @@ with Ghdlcomp; with Foreigns; package body Ghdlrun is - Snap_Filename : GNAT.OS_Lib.String_Access := null; - procedure Foreign_Hook (Decl : Iir; Info : Translation.Foreign_Info_Type; Ortho : O_Dnode); @@ -91,8 +82,7 @@ package body Ghdlrun is Setup_Libraries (False); Libraries.Load_Std_Library; - Ortho_Mcode.Init; - Binary_File.Memory.Write_Memory_Init; + Ortho_Jit.Init; Translation.Initialize; Canon.Canon_Flag_Add_Labels := True; @@ -114,8 +104,6 @@ package body Ghdlrun is -- This may happen (bad entity for example). raise Compilation_Error; end if; - - Ortho_Mcode.Finish; end Compile_Elab; -- Set options. @@ -221,22 +209,7 @@ package body Ghdlrun is end Find_Untruncated_Text_Read; procedure Def (Decl : O_Dnode; Addr : Address) - is - use Ortho_Code.Binary; - begin - Binary_File.Memory.Set_Symbol_Address (Get_Decl_Symbol (Decl), Addr); - end Def; - - function Get_Address (Decl : O_Dnode) return Address - is - use Interfaces; - use Ortho_Code.Binary; - - function Conv is new Ada.Unchecked_Conversion - (Source => Unsigned_32, Target => Address); - begin - return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl))); - end Get_Address; + renames Ortho_Jit.Set_Address; procedure Foreign_Hook (Decl : Iir; Info : Translation.Foreign_Info_Type; @@ -270,7 +243,7 @@ package body Ghdlrun is procedure Run is use Interfaces; - use Ortho_Code.Binary; + --use Ortho_Code.Binary; function Conv is new Ada.Unchecked_Conversion (Source => Address, Target => Elaborate_Acc); @@ -281,13 +254,6 @@ package body Ghdlrun is Ada.Text_IO.Put_Line ("Linking in memory"); end if; - if Ortho_Code.Debug.Flag_Debug_Hli then - -- Can't generate code in HLI. - raise Compile_Error; - end if; - - Ortho_Code.Abi.Link_Intrinsics; - Def (Trans_Decls.Ghdl_Memcpy, Grt.Lib.Ghdl_Memcpy'Address); Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0, @@ -574,43 +540,30 @@ package body Ghdlrun is Def (Decl, Grt.Files.Ghdl_Untruncated_Text_Read'Address); end if; - Binary_File.Memory.Write_Memory_Relocate (Err); + Ortho_Jit.Link (Err); if Err then raise Compile_Error; end if; Std_Standard_Boolean_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); + Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); Std_Standard_Bit_RTI_Ptr := - Get_Address (Trans_Decls.Std_Standard_Bit_Rti); + Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Bit_Rti); if Ieee.Std_Logic_1164.Resolved /= Null_Iir then Decl := Translation.Get_Resolv_Ortho_Decl (Ieee.Std_Logic_1164.Resolved); if Decl /= O_Dnode_Null then - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address (Decl); + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := + Ortho_Jit.Get_Address (Decl); end if; end if; Flag_String := Flags.Flag_String; - Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate)); - - if Snap_Filename /= null then - declare - Fd : File_Descriptor; - begin - Fd := Create_File (Snap_Filename.all, Binary); - if Fd = Invalid_FD then - Error_Msg_Option ("can't open '" & Snap_Filename.all & "'"); - else - Binary_File.Elf.Write_Elf (Fd); - Close (Fd); - end if; - end; - end if; + Elaborate_Proc := + Conv (Ortho_Jit.Get_Address (Trans_Decls.Ghdl_Elaborate)); - -- Free all the memory. - Ortho_Mcode.Free_All; + Ortho_Jit.Finish; Translation.Finalize; Lists.Initialize; @@ -618,7 +571,6 @@ package body Ghdlrun is Nodes.Initialize; Files_Map.Initialize; Name_Table.Initialize; - Binary_File.Finish; if Flag_Verbose then Ada.Text_IO.Put_Line ("Starting simulation"); @@ -628,33 +580,6 @@ package body Ghdlrun is --V := Ghdl_Main (1, Gnat_Argv); end Run; - function Decode_Option (Option : String) return Boolean - is - Opt : constant String (1 .. Option'Length) := Option; - begin - if Opt = "-g" then - Flag_Debug := Debug_Dwarf; - return True; - elsif Opt'Length > 5 and then Opt (1 .. 5) = "--be-" then - Ortho_Code.Debug.Set_Be_Flag (Opt); - return True; - elsif Opt'Length > 7 and then Opt (1 .. 7) = "--snap=" then - Snap_Filename := new String'(Opt (8 .. Opt'Last)); - return True; - else - return False; - end if; - end Decode_Option; - - procedure Disp_Long_Help - is - use Ada.Text_IO; - begin - Put_Line (" -g Generate debugging informations"); - Put_Line (" --debug-be=X Set X internal debugging flags"); - Put_Line (" --snap=FILE Write memory snapshot to FILE"); - end Disp_Long_Help; - -- Command run help. type Command_Run_Help is new Command_Type with null record; @@ -704,8 +629,8 @@ package body Ghdlrun is Compile_Elab'Access, Set_Run_Options'Access, Run'Access, - Decode_Option'Access, - Disp_Long_Help'Access); + Ortho_Jit.Decode_Option'Access, + Ortho_Jit.Disp_Help'Access); Ghdlcomp.Register_Commands; Register_Command (new Command_Run_Help); Trans_Be.Register_Translation_Back_End; |