diff options
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 32 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 20 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 10 |
3 files changed, 39 insertions, 23 deletions
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index ce20e2c..b92a02e 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -132,7 +132,8 @@ package body Ghdldrv is end My_Spawn; -- Compile FILE with additional argument OPTS. - procedure Do_Compile (Options : Argument_List; File : String) + procedure Do_Compile + (Options : Argument_List; File : String; In_Work : Boolean) is Obj_File : String_Access; Asm_File : String_Access; @@ -142,7 +143,7 @@ package body Ghdldrv is -- Create post file. case Compile_Kind is when Compile_Debug => - Post_File := Append_Suffix (File, Post_Suffix); + Post_File := Append_Suffix (File, Post_Suffix, In_Work); when others => null; end case; @@ -151,14 +152,14 @@ package body Ghdldrv is case Compile_Kind is when Compile_Gcc | Compile_Debug => - Asm_File := Append_Suffix (File, Asm_Suffix); + Asm_File := Append_Suffix (File, Asm_Suffix, In_Work); when Compile_Llvm | Compile_Mcode => null; end case; -- Create obj file (may not be used, but the condition isn't simple). - Obj_File := Append_Suffix (File, Get_Object_Suffix.all); + Obj_File := Append_Suffix (File, Get_Object_Suffix.all, In_Work); -- Compile. declare @@ -746,7 +747,7 @@ package body Ghdldrv is Setup_Compiler (False); for I in Args'Range loop - Do_Compile (Nil_Opt, Args (I).all); + Do_Compile (Nil_Opt, Args (I).all, True); end loop; end Perform_Action; @@ -781,7 +782,13 @@ package body Ghdldrv is -- Set a name for the elaboration files. Use the basename of the -- output file, so that parallel builds with different output files -- are allowed. - Elab_Name := new String'(Elab_Prefix & Get_Base_Name (Output_File.all)); + declare + Dir_Pos : constant Natural := Get_Basename_Pos (Output_File.all); + begin + Elab_Name := new String' + (Output_File (Output_File'First .. Dir_Pos) + & Elab_Prefix & Output_File (Dir_Pos + 1 .. Output_File'Last)); + end; end Set_Elab_Units; procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List) @@ -805,7 +812,7 @@ package body Ghdldrv is Comp_List (2) := Unit_Name; Comp_List (3) := new String'("-l"); Comp_List (4) := Filelist_Name; - Do_Compile (Comp_List, Elab_Name.all); + Do_Compile (Comp_List, Elab_Name.all, False); Free (Comp_List (3)); Free (Comp_List (1)); end Bind; @@ -822,15 +829,14 @@ package body Ghdldrv is Comp_List (Index) := new String'("--ghdl-source=" & Files (I).all); Index := Index + 1; end loop; - Do_Compile (Comp_List, Elab_Name.all); + Do_Compile (Comp_List, Elab_Name.all, False); Free (Comp_List (1)); for I in 3 .. Comp_List'Last loop Free (Comp_List (I)); end loop; end Bind_Anaelab; - procedure Link (Add_Std : Boolean; - Disp_Only : Boolean) + procedure Link (Add_Std : Boolean; Disp_Only : Boolean) is Last_File : Natural; begin @@ -852,7 +858,7 @@ package body Ghdldrv is Obj_File : String_Access; Std_File : String_Access; begin - Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all); + Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all, False); P := 0; Args (P + 1) := Dash_o; Args (P + 2) := Output_File; @@ -1416,7 +1422,7 @@ package body Ghdldrv is end if; if In_Work then - Do_Compile (Nil_Args, Image (File_Id)); + Do_Compile (Nil_Args, Image (File_Id), True); else declare use Libraries; @@ -1437,7 +1443,7 @@ package body Ghdldrv is Lib_Args (2) := new String' ("--workdir=" & Image (Work_Directory)); end if; - Do_Compile (Lib_Args, Image (File_Id)); + Do_Compile (Lib_Args, Image (File_Id), True); Work_Directory := Prev_Workdir; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 8e2eceb..8419715 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -182,7 +182,7 @@ package body Ghdllocal is return I; end if; end loop; - return 0; + return Pathname'First - 1; end Get_Basename_Pos; -- Simple lower case conversion, used to compare with "bin". @@ -207,7 +207,7 @@ package body Ghdllocal is Last : Natural; begin Last := Get_Basename_Pos (Prog_Path); - if Last = 0 then + if Last < Prog_Path'First then -- No directory in Prog_Path. This is not expected. return; end if; @@ -225,7 +225,7 @@ package body Ghdllocal is -- Skip executable name Last := Get_Basename_Pos (Pathname); - if Last = 0 then + if Last < Pathname'First then return; end if; @@ -297,7 +297,7 @@ package body Ghdllocal is -- Skip '/bin' directory if present Pos := Get_Basename_Pos (Pathname (Pathname'First .. Last)); - if Pos = 0 then + if Pos < Pathname'First then return; end if; if To_Lower (Pathname (Pos + 1 .. Last)) = "bin" then @@ -323,7 +323,7 @@ package body Ghdllocal is -- If the command name is a relative path, deduce prefix from it -- and current path. - if Get_Basename_Pos (Prog_Path) /= 0 then + if Get_Basename_Pos (Prog_Path) >= Prog_Path'First then if Is_Executable_File (Prog_Path) then Set_Prefix_From_Program_Path (Get_Current_Dir & Directory_Separator & Prog_Path); @@ -559,12 +559,18 @@ package body Ghdllocal is return Filename (First .. Last); end Get_Base_Name; - function Append_Suffix (File : String; Suffix : String) return String_Access + function Append_Suffix + (File : String; Suffix : String; In_Work : Boolean := True) + return String_Access is use Name_Table; Basename : constant String := Get_Base_Name (File); begin - Image (Libraries.Work_Directory); + if In_Work then + Image (Libraries.Work_Directory); + else + Nam_Length := Nam_Buffer'First - 1; + end if; Nam_Buffer (Nam_Length + 1 .. Nam_Length + Basename'Length) := Basename; Nam_Length := Nam_Length + Basename'Length; diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 7c5d193..b051aae 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -71,11 +71,15 @@ package Ghdllocal is function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True) return String; - -- Get the position of the last directory separator or 0 if none. + -- Get the position of the last directory separator or Pathname'First - 1 + -- if none. function Get_Basename_Pos (Pathname : String) return Natural; - function Append_Suffix (File : String; Suffix : String) - return String_Access; + -- Build a filename based on FILE: append SUFFIX as extension, and + -- if IN_WORK is true prepend the workdir. + function Append_Suffix + (File : String; Suffix : String; In_Work : Boolean := True) + return String_Access; -- Return TRUE is UNIT can be at the apex of a design hierarchy. function Is_Top_Entity (Unit : Iir) return Boolean; |