|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S I N P U T . D --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2002-2019, Free Software Foundation, Inc. --
|
|
111
|
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- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
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 --
|
|
|
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
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;
|
|
|
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
|
|
|
42 FD : File_Descriptor;
|
|
|
43 SFR : Source_File_Record renames Source_File.Table (Dfile);
|
|
|
44 Src : Source_Buffer_Ptr;
|
|
|
45 begin
|
|
|
46 Trim_Lines_Table (Dfile);
|
|
|
47 Close_Debug_File;
|
|
|
48
|
|
|
49 -- Now we need to read the file that we wrote and store it in memory for
|
|
|
50 -- subsequent access.
|
|
|
51
|
|
|
52 Read_Source_File
|
|
|
53 (SFR.Full_Debug_Name, SFR.Source_First, SFR.Source_Last, Src, FD);
|
|
|
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);
|
|
|
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
|
|
|
68 Loc :=
|
|
|
69 ((Source_File.Table (Source_File.Last).Source_Last + Source_Align) /
|
|
|
70 Source_Align) * Source_Align;
|
|
|
71 Source_File.Append (Source_File.Table (Source));
|
|
|
72 Dfile := Source_File.Last;
|
|
|
73
|
|
|
74 declare
|
|
|
75 S : Source_File_Record renames Source_File.Table (Dfile);
|
|
|
76
|
|
|
77 begin
|
|
|
78 S.Index := Dfile;
|
|
|
79 S.Full_Debug_Name := Create_Debug_File (S.File_Name);
|
|
|
80 S.Debug_Source_Name := Strip_Directory (S.Full_Debug_Name);
|
|
|
81 S.Source_Text := null;
|
|
|
82 S.Source_First := Loc;
|
|
|
83 S.Source_Last := Loc;
|
|
|
84 S.Lines_Table := null;
|
|
|
85 S.Last_Source_Line := 1;
|
|
|
86
|
|
|
87 -- Allocate lines table, guess that it needs to be three times bigger
|
|
|
88 -- than the original source (in number of lines).
|
|
|
89
|
|
|
90 Alloc_Line_Tables
|
|
|
91 (S, Int (Source_File.Table (Source).Last_Source_Line * 3));
|
|
|
92 S.Lines_Table (1) := Loc;
|
|
|
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;
|
|
|
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
|
|
|
117 -- Here we write the line, compute the source location for the following
|
|
|
118 -- line, allocate its table entry, and update the source record entry.
|
|
|
119
|
|
|
120 else
|
|
|
121 Write_Debug_Info (Str (Str'First .. Str'Last - 1));
|
|
|
122 Loc := Loc - 1 + Source_Ptr (Str'Length + Debug_File_Eol_Length);
|
|
|
123 Add_Line_Tables_Entry (S, Loc);
|
|
|
124 S.Source_Last := Loc;
|
|
|
125 Set_Source_File_Index_Table (Dfile);
|
|
|
126 end if;
|
|
|
127 end Write_Debug_Line;
|
|
|
128
|
|
|
129 end Sinput.D;
|
