[thirdparty/gcc.git] / gcc / ada / sinput-d.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S I N P U T . D                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2002-2019, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Debug;         use Debug;
with Osint;         use Osint;
with Osint.C;       use Osint.C;
with Output;        use Output;
with System.OS_Lib; use System.OS_Lib;

package body Sinput.D is

   Dfile : Source_File_Index;
   --  Index of currently active debug source file

   ------------------------
   -- Close_Debug_Source --
   ------------------------

   procedure Close_Debug_Source is
      FD   : File_Descriptor;
      SFR  : Source_File_Record renames Source_File.Table (Dfile);
      Src  : Source_Buffer_Ptr;
   begin
      Trim_Lines_Table (Dfile);
      Close_Debug_File;

      --  Now we need to read the file that we wrote and store it in memory for
      --  subsequent access.

      Read_Source_File
        (SFR.Full_Debug_Name, SFR.Source_First, SFR.Source_Last, Src, FD);
      SFR.Source_Text := Src;
      pragma Assert (SFR.Source_Text'First = SFR.Source_First);
      pragma Assert (SFR.Source_Text'Last = SFR.Source_Last);
   end Close_Debug_Source;

   -------------------------
   -- Create_Debug_Source --
   -------------------------

   procedure Create_Debug_Source
     (Source : Source_File_Index;
      Loc    : out Source_Ptr)
   is
   begin
      Loc :=
        ((Source_File.Table (Source_File.Last).Source_Last + Source_Align) /
           Source_Align) * Source_Align;
      Source_File.Append (Source_File.Table (Source));
      Dfile := Source_File.Last;

      declare
         S : Source_File_Record renames Source_File.Table (Dfile);

      begin
         S.Index             := Dfile;
         S.Full_Debug_Name   := Create_Debug_File (S.File_Name);
         S.Debug_Source_Name := Strip_Directory (S.Full_Debug_Name);
         S.Source_Text       := null;
         S.Source_First      := Loc;
         S.Source_Last       := Loc;
         S.Lines_Table       := null;
         S.Last_Source_Line  := 1;

         --  Allocate lines table, guess that it needs to be three times bigger
         --  than the original source (in number of lines).

         Alloc_Line_Tables
           (S, Int (Source_File.Table (Source).Last_Source_Line * 3));
         S.Lines_Table (1) := Loc;

         if Debug_Flag_L then
            Write_Str ("Sinput.D.Create_Debug_Source: created source ");
            Write_Int (Int (Dfile));
            Write_Str (" for ");
            Write_Str (Get_Name_String (S.Full_Debug_Name));
            Write_Line ("");
         end if;
      end;
   end Create_Debug_Source;

   ----------------------
   -- Write_Debug_Line --
   ----------------------

   procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
      S : Source_File_Record renames Source_File.Table (Dfile);

   begin
      --  Ignore write request if null line at start of file

      if Str'Length = 0 and then Loc = S.Source_First then
         return;

      --  Here we write the line, compute the source location for the following
      --  line, allocate its table entry, and update the source record entry.

      else
         Write_Debug_Info (Str (Str'First .. Str'Last - 1));
         Loc := Loc - 1 + Source_Ptr (Str'Length + Debug_File_Eol_Length);
         Add_Line_Tables_Entry (S, Loc);
         S.Source_Last := Loc;
         Set_Source_File_Index_Table (Dfile);
      end if;
   end Write_Debug_Line;

end Sinput.D;
Commit	Line	Data
43ff4547 GB	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- S I N P U T . D --
	6	-- --
	7	-- B o d y --
	8	-- --
1d005acc	9	-- Copyright (C) 2002-2019, Free Software Foundation, Inc. --
43ff4547 GB	10	-- --
	11	-- GNAT is free software; you can redistribute it and/or modify it under --
	12	-- terms of the GNU General Public License as published by the Free Soft- --
b5c84c3c	13	-- ware Foundation; either version 3, or (at your option) any later ver- --
43ff4547 GB	14	-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
	15	-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
	16	-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
	17	-- for more details. You should have received a copy of the GNU General --
b5c84c3c RD	18	-- Public License distributed with GNAT; see file COPYING3. If not, go to --
b5c84c3c RD	19	-- http://www.gnu.org/licenses for a complete copy of the license. --
43ff4547 GB	20	-- --
43ff4547 GB	21	-- GNAT was originally developed by the GNAT team at New York University. --
1f02b6af	22	-- Extensive contributions were provided by Ada Core Technologies Inc. --
43ff4547 GB	23	-- --
	24	------------------------------------------------------------------------------
	25
cd644ae2 PMR	26	with Debug; use Debug;
	27	with Osint; use Osint;
	28	with Osint.C; use Osint.C;
	29	with Output; use Output;
	30	with System.OS_Lib; use System.OS_Lib;
43ff4547 GB	31
	32	package body Sinput.D is
	33
	34	Dfile : Source_File_Index;
	35	-- Index of currently active debug source file
	36
	37	------------------------
	38	-- Close_Debug_Source --
	39	------------------------
	40
	41	procedure Close_Debug_Source is
cd644ae2	42	FD : File_Descriptor;
211e7410	43	SFR : Source_File_Record renames Source_File.Table (Dfile);
43ff4547	44	Src : Source_Buffer_Ptr;
43ff4547 GB	45	begin
	46	Trim_Lines_Table (Dfile);
	47	Close_Debug_File;
	48
b8e51f72 TQ	49	-- Now we need to read the file that we wrote and store it in memory for
b8e51f72 TQ	50	-- subsequent access.
43ff4547 GB	51
43ff4547 GB	52	Read_Source_File
cd644ae2	53	(SFR.Full_Debug_Name, SFR.Source_First, SFR.Source_Last, Src, FD);
211e7410 AC	54	SFR.Source_Text := Src;
	55	pragma Assert (SFR.Source_Text'First = SFR.Source_First);
	56	pragma Assert (SFR.Source_Text'Last = SFR.Source_Last);
43ff4547 GB	57	end Close_Debug_Source;
	58
	59	-------------------------
	60	-- Create_Debug_Source --
	61	-------------------------
	62
	63	procedure Create_Debug_Source
	64	(Source : Source_File_Index;
	65	Loc : out Source_Ptr)
	66	is
	67	begin
cd38efa5 AC	68	Loc :=
	69	((Source_File.Table (Source_File.Last).Source_Last + Source_Align) /
	70	Source_Align) * Source_Align;
1d6f10a1	71	Source_File.Append (Source_File.Table (Source));
43ff4547 GB	72	Dfile := Source_File.Last;
	73
	74	declare
	75	S : Source_File_Record renames Source_File.Table (Dfile);
	76
	77	begin
211e7410	78	S.Index := Dfile;
fbf5a39b AC	79	S.Full_Debug_Name := Create_Debug_File (S.File_Name);
fbf5a39b AC	80	S.Debug_Source_Name := Strip_Directory (S.Full_Debug_Name);
211e7410	81	S.Source_Text := null;
43ff4547 GB	82	S.Source_First := Loc;
	83	S.Source_Last := Loc;
	84	S.Lines_Table := null;
	85	S.Last_Source_Line := 1;
	86
b8e51f72 TQ	87	-- Allocate lines table, guess that it needs to be three times bigger
b8e51f72 TQ	88	-- than the original source (in number of lines).
43ff4547 GB	89
	90	Alloc_Line_Tables
	91	(S, Int (Source_File.Table (Source).Last_Source_Line * 3));
	92	S.Lines_Table (1) := Loc;
211e7410 AC	93
	94	if Debug_Flag_L then
	95	Write_Str ("Sinput.D.Create_Debug_Source: created source ");
	96	Write_Int (Int (Dfile));
	97	Write_Str (" for ");
	98	Write_Str (Get_Name_String (S.Full_Debug_Name));
	99	Write_Line ("");
	100	end if;
43ff4547 GB	101	end;
	102	end Create_Debug_Source;
	103
	104	----------------------
	105	-- Write_Debug_Line --
	106	----------------------
	107
	108	procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
	109	S : Source_File_Record renames Source_File.Table (Dfile);
	110
	111	begin
	112	-- Ignore write request if null line at start of file
	113
	114	if Str'Length = 0 and then Loc = S.Source_First then
	115	return;
	116
b8e51f72 TQ	117	-- Here we write the line, compute the source location for the following
b8e51f72 TQ	118	-- line, allocate its table entry, and update the source record entry.
43ff4547 GB	119
	120	else
	121	Write_Debug_Info (Str (Str'First .. Str'Last - 1));
43ff4547	122	Loc := Loc - 1 + Source_Ptr (Str'Length + Debug_File_Eol_Length);
fbf5a39b	123	Add_Line_Tables_Entry (S, Loc);
43ff4547	124	S.Source_Last := Loc;
b8e51f72	125	Set_Source_File_Index_Table (Dfile);
43ff4547 GB	126	end if;
	127	end Write_Debug_Line;
	128
	129	end Sinput.D;