aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sinput-l.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 17:54:39 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 17:54:39 +0200
commit211e7410b32e6cb4b45d414883c5d6d5f37faa31 (patch)
tree55dae71c0ef21060e28548eed6b71f8e8f1b0965 /gcc/ada/sinput-l.adb
parentf66c70dc0392cfa06f6414a8b9fa65adb9051b58 (diff)
downloadgcc-211e7410b32e6cb4b45d414883c5d6d5f37faa31.zip
gcc-211e7410b32e6cb4b45d414883c5d6d5f37faa31.tar.gz
gcc-211e7410b32e6cb4b45d414883c5d6d5f37faa31.tar.bz2
[multiple changes]
2017-04-25 Arnaud Charlet <charlet@adacore.com> * exp_ch4.adb (Expand_N_Case_Expression): Emit error message when generating C code on complex case expressions. 2017-04-25 Arnaud Charlet <charlet@adacore.com> * sem_prag.adb (Analyze_Pragma): Generate a warning instead of silently ignoring pragma Ada_xxx in Latest_Ada_Only mode. * directio.ads, ioexcept.ads, sequenio.ads, text_io.ads: Use Ada_2012 instead of Ada_2005 to be compatible with the above change. * bindgen.adb: Silence new warning on pragma Ada_95. 2017-04-25 Hristian Kirtchev <kirtchev@adacore.com> * checks.adb (Generate_Range_Check): Revert part of previous change. 2017-04-25 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Try_Container_Indexing): Handle properly a container indexing operation that appears as a an actual in a parameter association in a procedure call. 2017-04-25 Olivier Ramonat <ramonat@adacore.com> * prj-proc.adb, sem_util.adb, s-stposu.adb, sem_attr.adb, prj-conf.ads: Fix spelling mistakes. 2017-04-25 Bob Duff <duff@adacore.com> * types.ads, osint.adb, sinput-c.adb, sinput-d.adb, sinput-l.adb, * sinput-p.adb: Use regular fat pointers, with bounds checking, for source buffers. Fix misc obscure bugs. * sinput.ads, sinput.adb: Use regular fat pointers, with bounds checking, for source buffers. Modify representation clause for Source_File_Record as appropriate. Move Source_File_Index_Table from spec to body, because it is not used outside the body. Move Set_Source_File_Index_Table into the private part, because it is used only in the body and in children. Use trickery to modify the dope in the generic instantiation case. It's ugly, but not as ugly as the previous method. Fix documentation. Remove obsolete code. * fname-sf.adb, targparm.adb: Fix misc out-of-bounds indexing in source buffers. * fmap.adb: Avoid conversions from one string type to another. Remove a use of global name buffer. * osint.ads, sfn_scan.ads, sfn_scan.adb, sinput-c.ads: Comment fixes. From-SVN: r247252
Diffstat (limited to 'gcc/ada/sinput-l.adb')
-rw-r--r--gcc/ada/sinput-l.adb116
1 files changed, 47 insertions, 69 deletions
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index aa747ce..a64283e 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -142,6 +142,12 @@ package body Sinput.L is
Source_File.Append (Source_File.Table (Xold));
Xnew := Source_File.Last;
+ if Debug_Flag_L then
+ Write_Str ("Create_Instantiation_Source: created source ");
+ Write_Int (Int (Xnew));
+ Write_Line ("");
+ end if;
+
declare
Sold : Source_File_Record renames Source_File.Table (Xold);
Snew : Source_File_Record renames Source_File.Table (Xnew);
@@ -149,6 +155,7 @@ package body Sinput.L is
Inst_Spec : Node_Id;
begin
+ Snew.Index := Xnew;
Snew.Inlined_Body := Inlined_Body;
Snew.Inherited_Pragma := Inherited_Pragma;
Snew.Template := Xold;
@@ -213,8 +220,8 @@ package body Sinput.L is
end if;
-- Now compute the new values of Source_First and Source_Last and
- -- adjust the source file pointer to have the correct virtual origin
- -- for the new range of values.
+ -- adjust the source file pointer to have the correct bounds for the
+ -- new range of values.
-- Source_First must be greater than the last Source_Last value and
-- also must be a multiple of Source_Align.
@@ -229,6 +236,19 @@ package body Sinput.L is
Snew.Sloc_Adjust := Sold.Sloc_Adjust - Factor.Adjust;
+ -- Modify the Dope of the instance Source_Text to use the
+ -- above-computed bounds.
+
+ declare
+ Dope : constant Dope_Ptr :=
+ new Dope_Rec'(Snew.Source_First, Snew.Source_Last);
+ begin
+ Snew.Source_Text := Sold.Source_Text;
+ Set_Dope (Snew.Source_Text'Address, Dope);
+ pragma Assert (Snew.Source_Text'First = Snew.Source_First);
+ pragma Assert (Snew.Source_Text'Last = Snew.Source_Last);
+ end;
+
if Debug_Flag_L then
Write_Eol;
Write_Str ("*** Create instantiation source for ");
@@ -307,31 +327,6 @@ package body Sinput.L is
Write_Location (Sloc (Inst_Node));
Write_Eol;
end if;
-
- -- For a given character in the source, a higher subscript will be
- -- used to access the instantiation, which means that the virtual
- -- origin must have a corresponding lower value. We compute this new
- -- origin by taking the address of the appropriate adjusted element
- -- in the old array. Since this adjusted element will be at a
- -- negative subscript, we must suppress checks.
-
- declare
- pragma Suppress (All_Checks);
-
- pragma Warnings (Off);
- -- This unchecked conversion is aliasing safe, since it is never
- -- used to create improperly aliased pointer values.
-
- function To_Source_Buffer_Ptr is new
- Unchecked_Conversion (Address, Source_Buffer_Ptr);
-
- pragma Warnings (On);
-
- begin
- Snew.Source_Text :=
- To_Source_Buffer_Ptr
- (Sold.Source_Text (-Factor.Adjust)'Address);
- end;
end;
end Create_Instantiation_Source;
@@ -405,6 +400,14 @@ package body Sinput.L is
Source_File.Increment_Last;
X := Source_File.Last;
+ if Debug_Flag_L then
+ Write_Str ("Sinput.L.Load_File: created source ");
+ Write_Int (Int (X));
+ Write_Str (" for ");
+ Write_Str (Get_Name_String (N));
+ Write_Line ("");
+ end if;
+
-- Compute starting index, respecting alignment requirement
if X = Source_File.First then
@@ -529,7 +532,8 @@ package body Sinput.L is
Source_Text => Src,
Template => No_Source_File,
Unit => No_Unit,
- Time_Stamp => Osint.Current_Source_File_Stamp);
+ Time_Stamp => Osint.Current_Source_File_Stamp,
+ Index => X);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
S.Lines_Table (1) := Lo;
@@ -688,54 +692,28 @@ package body Sinput.L is
-- Create the new source buffer
declare
- subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
- -- Physical buffer allocated
-
- type Actual_Source_Ptr is access Actual_Source_Buffer;
- -- Pointer type for the physical buffer allocated
-
- Actual_Ptr : constant Actual_Source_Ptr :=
- new Actual_Source_Buffer;
- -- Actual physical buffer
+ Var_Ptr : constant Source_Buffer_Ptr_Var :=
+ new Source_Buffer (Lo .. Hi);
+ -- Allocate source buffer, allowing extra character at
+ -- end for EOF.
begin
- Actual_Ptr (Lo .. Hi - 1) :=
+ Var_Ptr (Lo .. Hi - 1) :=
Prep_Buffer (1 .. Prep_Buffer_Last);
- Actual_Ptr (Hi) := EOF;
-
- -- Now we need to work out the proper virtual origin
- -- pointer to return. This is Actual_Ptr (0)'Address, but
- -- we have to be careful to suppress checks to compute
- -- this address.
-
- declare
- pragma Suppress (All_Checks);
-
- pragma Warnings (Off);
- -- This unchecked conversion is aliasing safe, since
- -- it is never used to create improperly aliased
- -- pointer values.
-
- function To_Source_Buffer_Ptr is new
- Unchecked_Conversion (Address, Source_Buffer_Ptr);
-
- pragma Warnings (On);
-
- begin
- Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
+ Var_Ptr (Hi) := EOF;
+ Src := Var_Ptr.all'Access;
+ end;
- -- Record in the table the new source buffer and the
- -- new value of Hi.
+ -- Record in the table the new source buffer and the
+ -- new value of Hi.
- Source_File.Table (X).Source_Text := Src;
- Source_File.Table (X).Source_Last := Hi;
+ Source_File.Table (X).Source_Text := Src;
+ Source_File.Table (X).Source_Last := Hi;
- -- Reset Last_Line to 1, because the lines do not
- -- have necessarily the same starts and lengths.
+ -- Reset Last_Line to 1, because the lines do not
+ -- have necessarily the same starts and lengths.
- Source_File.Table (X).Last_Source_Line := 1;
- end;
- end;
+ Source_File.Table (X).Last_Source_Line := 1;
end if;
end;
end if;