diff options
| -rw-r--r-- | src/files_map.adb | 70 | ||||
| -rw-r--r-- | src/files_map.ads | 15 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 44 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 7 | ||||
| -rw-r--r-- | src/libraries.adb | 1 |
5 files changed, 99 insertions, 38 deletions
diff --git a/src/files_map.adb b/src/files_map.adb index afd0d9a6f..198c272d5 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -146,12 +146,6 @@ package body Files_Map is return No_Source_File_Entry; end Location_To_File; - function Location_File_To_Pos - (Location : Location_Type; File : Source_File_Entry) return Source_Ptr is - begin - return Source_Ptr (Location - Source_Files.Table (File).First_Location); - end Location_File_To_Pos; - procedure Location_To_File_Pos (Location : Location_Type; File : out Source_File_Entry; Pos : out Source_Ptr) is @@ -278,18 +272,15 @@ package body Files_Map is -- A HT (tabulation) moves the cursor to the next position multiple of the -- tab stop. -- The first character is at position 1 and at offset 0. - procedure Coord_To_Position (File : Source_File_Entry; - Line_Pos : Source_Ptr; - Offset : Natural; - Name : out Name_Id; - Col : out Natural) + function Coord_To_Col (File : Source_File_Entry; + Line_Pos : Source_Ptr; + Offset : Natural) return Natural is Source_File: Source_File_Record renames Source_Files.Table (File); Res : Positive := 1; begin - Name := Source_File.File_Name; if Offset = 0 then - Col := Res; + return Res; else for I in Line_Pos .. Line_Pos + Source_Ptr (Offset) - 1 loop if Source_File.Source (I) = ASCII.HT then @@ -298,8 +289,18 @@ package body Files_Map is Res := Res + 1; end if; end loop; - Col := Res; + return Res; end if; + end Coord_To_Col; + + procedure Coord_To_Position (File : Source_File_Entry; + Line_Pos : Source_Ptr; + Offset : Natural; + Name : out Name_Id; + Col : out Natural) is + begin + Name := Source_Files.Table (File).File_Name; + Col := Coord_To_Col (File, Line_Pos, Offset); end Coord_To_Position; -- Should only be called by Location_To_Coord. @@ -435,7 +436,7 @@ package body Files_Map is << Found >> null; Line_Pos := Source_File.Lines_Table (Line); - Offset := Natural (Pos - Source_File.Lines_Table (Line)); + Offset := Natural (Pos - Line_Pos); -- Update cache. Source_File.Cache_Pos := Pos; @@ -485,6 +486,36 @@ package body Files_Map is end case; end Location_To_Coord; + function Location_File_To_Pos + (Location : Location_Type; File : Source_File_Entry) return Source_Ptr is + begin + return Source_Ptr (Location - Source_Files.Table (File).First_Location); + end Location_File_To_Pos; + + function Location_File_To_Line + (Location : Location_Type; File : Source_File_Entry) return Natural + is + Line_Pos : Source_Ptr; + Line : Natural; + Offset : Natural; + begin + Location_To_Coord + (Source_Files.Table (File), Location_File_To_Pos (Location, File), + Line_Pos, Line, Offset); + return Line; + end Location_File_To_Line; + + function Location_File_Line_To_Col + (Loc : Location_Type; File : Source_File_Entry; Line : Natural) + return Natural + is + F : Source_File_Record renames Source_Files.Table (File); + Line_Pos : constant Source_Ptr := F.Lines_Table (Line); + Pos : constant Source_Ptr := Location_File_To_Pos (Loc, File); + begin + return Coord_To_Col (File, Line_Pos, Natural (Pos - Line_Pos)); + end Location_File_Line_To_Col; + -- Convert the first digit of VAL into a character (base 10). function Digit_To_Char (Val: Natural) return Character is begin @@ -1131,7 +1162,7 @@ package body Files_Map is end loop; end Debug_Source_Lines; - procedure Debug_Source_File is + procedure Debug_Source_Files is begin for I in Source_Files.First .. Source_Files.Last loop declare @@ -1142,8 +1173,12 @@ package body Files_Map is Put (" dir:" & Image (F.Directory)); Put (" length:" & Natural'Image (F.File_Length)); New_Line; + Put (" location:" & Location_Type'Image (F.First_Location) + & " -" & Location_Type'Image (F.Last_Location)); + New_Line; if F.Checksum /= No_File_Checksum_Id then Put (" checksum: " & Get_File_Checksum_String (F.Checksum)); + New_Line; end if; case F.Kind is when Source_File_File => @@ -1156,10 +1191,9 @@ package body Files_Map is end case; end; end loop; - end Debug_Source_File; + end Debug_Source_Files; pragma Unreferenced (Debug_Source_Lines); - pragma Unreferenced (Debug_Source_File); pragma Unreferenced (Debug_Source_Loc); procedure Initialize is diff --git a/src/files_map.ads b/src/files_map.ads index c7c5da447..a29159db2 100644 --- a/src/files_map.ads +++ b/src/files_map.ads @@ -141,6 +141,15 @@ package Files_Map is function Location_File_To_Pos (Location : Location_Type; File : Source_File_Entry) return Source_Ptr; + -- Convert LOCATION and FILE to a line number. + function Location_File_To_Line + (Location : Location_Type; File : Source_File_Entry) return Natural; + + -- Get logical column (with HT expanded) from LOC, FILE and LINE. + function Location_File_Line_To_Col + (Loc : Location_Type; File : Source_File_Entry; Line : Natural) + return Natural; + -- Convert LOCATION into a source file FILE and an offset POS in the -- file. procedure Location_To_File_Pos (Location : Location_Type; @@ -202,4 +211,10 @@ package Files_Map is -- Free all memory and reinitialize. procedure Initialize; + +private + -- Debug procedures. + + -- Disp info about all source files + procedure Debug_Source_Files; end Files_Map; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 75ececd4f..1b34af41e 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -55,46 +55,54 @@ package body Ghdllocal is Compile_Init; end Init; - procedure Decode_Option (Cmd : in out Command_Lib; - Option : String; - Arg : String; - Res : out Option_Res) + function Decode_Driver_Option (Option : String) return Boolean is - pragma Unreferenced (Cmd); - pragma Unreferenced (Arg); - Opt : constant String (1 .. Option'Length) := Option; + subtype Opt_String is String (1 .. Option'Length); + Opt : Opt_String renames Option; begin - Res := Option_Bad; if Opt = "-v" and then Flag_Verbose = False then Flag_Verbose := True; - Res := Option_Ok; + return True; elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last)); - Res := Option_Ok; + return True; elsif Opt = "--ieee=synopsys" then Flag_Ieee := Lib_Synopsys; - Res := Option_Ok; + return True; elsif Opt = "--ieee=mentor" then Flag_Ieee := Lib_Mentor; - Res := Option_Ok; + return True; elsif Opt = "--ieee=none" then Flag_Ieee := Lib_None; - Res := Option_Ok; + return True; elsif Opt = "--ieee=standard" then Flag_Ieee := Lib_Standard; - Res := Option_Ok; + return True; elsif Opt = "-m32" then Flag_32bit := True; - Res := Option_Ok; + return True; elsif Opt'Length >= 2 and then (Opt (2) = 'g' or Opt (2) = 'O') then -- Silently accept -g and -O. + return True; + else + return Options.Parse_Option (Opt); + end if; + end Decode_Driver_Option; + + procedure Decode_Option (Cmd : in out Command_Lib; + Option : String; + Arg : String; + Res : out Option_Res) + is + pragma Unreferenced (Cmd); + pragma Unreferenced (Arg); + begin + if Decode_Driver_Option (Option) then Res := Option_Ok; else - if Options.Parse_Option (Opt) then - Res := Option_Ok; - end if; + Res := Option_Bad; end if; end Decode_Option; diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 0809035b1..3624543d8 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -23,13 +23,16 @@ package Ghdllocal is -- Init procedure for the functionnal interface. procedure Compile_Init; + -- Handle: + -- --std=xx, --work=xx, -Pxxx, --workdir=x, --ieee=x, -Px, and -v + function Decode_Driver_Option (Option : String) return Boolean; + type Command_Lib is abstract new Command_Type with null record; -- Setup GHDL. Same as Compile_Init. procedure Init (Cmd : in out Command_Lib); - -- Handle: - -- --std=xx, --work=xx, -Pxxx, --workdir=x, --ieee=x, -Px, and -v + -- Handle driver options. procedure Decode_Option (Cmd : in out Command_Lib; Option : String; Arg : String; diff --git a/src/libraries.adb b/src/libraries.adb index d12947d53..4186fd4da 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -680,6 +680,7 @@ package body Libraries is -- Add the standard_file into the library. -- This is done after Load_Library, because it checks there is no -- previous files in the library. + Set_Location (Std_Library, Get_Location (Standard_Package)); Set_Parent (Std_Standard_File, Std_Library); Set_Chain (Std_Standard_File, Get_Design_File_Chain (Std_Library)); Set_Design_File_Chain (Std_Library, Std_Standard_File); |