Minor refactoring to simplify interfacing.

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);