diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/comperr.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/err_vars.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/fmap.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/fmap.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/fname-sf.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/gnatls.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/scn.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/scn.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sinput.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 14 | ||||
| -rw-r--r-- | gcc/ada/targparm.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/types.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/types.ads | 24 | ||||
| -rw-r--r-- | gcc/ada/types.h | 4 |
18 files changed, 81 insertions, 98 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index add3c60..64d9ded 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-04-25 Bob Duff <duff@adacore.com> + + * err_vars.ads, fmap.adb, fmap.ads, comperr.adb, fname-sf.adb, + types.adb, types.ads, types.h, sinput-l.adb, targparm.adb, + errout.adb, sinput.adb, sinput.ads, cstand.adb, scn.adb, + scn.ads, gnatls.adb: Eliminate the vestigial Internal_Source_File and + the Internal_Source buffer. This removes the incorrect call to "=" + the customer noticed. + Wrap remaining calls to "=" in Null_Source_Buffer_Ptr. We + eventually need to eliminate them altogether. Or else get rid + of zero-origin addressing. + 2017-04-25 Claire Dross <dross@adacore.com> * exp_util.ads (Expression_Contains_Primitives_Calls_Of): New diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 0403524..0892a86 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -265,7 +265,7 @@ package body Comperr is -- If we get a Src file, we use it - if Src /= null then + if not Null_Source_Buffer_Ptr (Src) then Lo := 0; Outer : while Lo < Hi loop diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 3d627c8..891fced 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -38,7 +38,6 @@ with Set_Targ; use Set_Targ; with Targparm; use Targparm; with Tbuild; use Tbuild; with Ttypes; use Ttypes; -with Scn; with Sem_Mech; use Sem_Mech; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -582,10 +581,6 @@ package body CStand is -- Start of processing for Create_Standard begin - -- Initialize scanner for internal scans of literals - - Scn.Initialize_Scanner (No_Unit, Internal_Source_File); - -- First step is to create defining identifiers for each entity for S in Standard_Entity_Type loop diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 0c2fb6f..0024687 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -80,7 +80,7 @@ package Err_Vars is Error_Msg_Exception : exception; -- Exception raised if Raise_Exception_On_Error is true - Current_Error_Source_File : Source_File_Index := Internal_Source_File; + Current_Error_Source_File : Source_File_Index := No_Source_File; -- Id of current messages. Used to post file name when unit changes. This -- is initialized to Main_Source_File at the start of a compilation, which -- means that no file names will be output unless there are errors in units diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 2d26d07..6003223 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -312,11 +312,6 @@ package body Errout is -- template in instantiation case, otherwise unchanged). begin - -- It is a fatal error to issue an error message when scanning from the - -- internal source buffer (see Sinput for further documentation) - - pragma Assert (Sinput.Source /= Internal_Source_Ptr); - -- Return if all errors are to be ignored if Errors_Must_Be_Ignored then diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index e618d3c..738d0ac 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, 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- -- @@ -306,7 +306,7 @@ package body Fmap is Name_Buffer (1 .. Name_Len) := File_Name; Read_Source_File (Name_Enter, 0, Hi, Src, Config); - if Src = null then + if Null_Source_Buffer_Ptr (Src) then Write_Str ("warning: could not read mapping file """); Write_Str (File_Name); Write_Line (""""); diff --git a/gcc/ada/fmap.ads b/gcc/ada/fmap.ads index 19aa069..9bdee4c 100644 --- a/gcc/ada/fmap.ads +++ b/gcc/ada/fmap.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, 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- -- @@ -42,7 +42,7 @@ package Fmap is procedure Initialize (File_Name : String); -- Initialize the mappings from the mapping file File_Name. - -- If the mapping file is incorrect (non existent file, truncated file, + -- If the mapping file is incorrect (nonexistent file, truncated file, -- duplicate entries), output a warning and do not initialize the mappings. -- Record the state of the mapping tables in case Update is called -- later on. diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb index f967c16..ea6a1a2 100644 --- a/gcc/ada/fname-sf.adb +++ b/gcc/ada/fname-sf.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -74,7 +74,7 @@ package body Fname.SF is Name_Len := 8; Read_Source_File (Name_Enter, 0, Hi, Src); - if Src /= null then + if not Null_Source_Buffer_Ptr (Src) then BS := To_Big_String_Ptr (Src); SP := BS (1 .. Natural (Hi))'Unrestricted_Access; Scan_SFN_Pragmas diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 6e2e382..10cc662 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -1653,7 +1653,7 @@ begin Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); - if Text = null then + if Null_Source_Buffer_Ptr (Text) then No_Runtime := True; end if; end; diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index f5a5190..7dc0dc5 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -209,21 +209,14 @@ package body Scn is begin Scanner.Initialize_Scanner (Index); - - if Index /= Internal_Source_File then - Set_Unit (Index, Unit); - end if; + Set_Unit (Index, Unit); Current_Source_Unit := Unit; - -- Set default for Comes_From_Source (except if we are going to process - -- an artificial string internally created within the compiler and - -- placed into internal source duffer). All nodes built now until we + -- Set default for Comes_From_Source. All nodes built now until we -- reenter the analyzer will have Comes_From_Source set to True - if Index /= Internal_Source_File then - Set_Comes_From_Source_Default (True); - end if; + Set_Comes_From_Source_Default (True); -- Check license if GNAT type header possibly present @@ -239,19 +232,7 @@ package body Scn is -- call Scan. Scan initial token (note this initializes Prev_Token, -- Prev_Token_Ptr). - -- There are two reasons not to do the Scan step in case if we - -- initialize the scanner for the internal source buffer: - - -- - The artificial string may not be created by the compiler in this - -- buffer when we call Initialize_Scanner - - -- - For these artificial strings a special way of scanning is used, so - -- the standard step of the scanner may just break the algorithm of - -- processing these strings. - - if Index /= Internal_Source_File then - Scan; - end if; + Scan; -- Clear flags for reserved words used as identifiers diff --git a/gcc/ada/scn.ads b/gcc/ada/scn.ads index f5628a9..77ebadc 100644 --- a/gcc/ada/scn.ads +++ b/gcc/ada/scn.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -39,9 +39,9 @@ package Scn is Index : Source_File_Index); -- Initialize lexical scanner for scanning a new file. The caller has -- completed the construction of the Units.Table entry for the specified - -- Unit and Index references the corresponding source file. A special - -- case is when Unit = No_Unit_Number, and Index corresponds to the - -- source index for reading the configuration pragma file. + -- Unit and Index references the corresponding source file. A special case + -- is when Unit = No_Unit, and Index corresponds to the source index for + -- reading the configuration pragma file. function Determine_Token_Casing return Casing_Type; -- Determines the casing style of the current token, which is either a diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 8141262d..aa747ce 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -416,7 +416,7 @@ package body Sinput.L is Osint.Read_Source_File (N, Lo, Hi, Src, T); - if Src = null then + if Null_Source_Buffer_Ptr (Src) then Source_File.Decrement_Last; return No_Source_File; diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 4d0cbdd..b3cfa49 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -876,19 +876,24 @@ package body Sinput is declare S : Source_File_Record renames Source_File.Table (J); + type Source_Buffer_Ptr_Var is access all Big_Source_Buffer; + procedure Free_Ptr is new Unchecked_Deallocation - (Big_Source_Buffer, Source_Buffer_Ptr); + (Big_Source_Buffer, Source_Buffer_Ptr_Var); + -- This works only because we're calling malloc, which keeps + -- track of the size on its own, ignoring the size of + -- Big_Source_Buffer, which is the wrong size. pragma Warnings (Off); -- This unchecked conversion is aliasing safe, since it is not -- used to create improperly aliased pointer values. - function To_Source_Buffer_Ptr is new - Unchecked_Conversion (Address, Source_Buffer_Ptr); + function To_Source_Buffer_Ptr_Var is new + Unchecked_Conversion (Address, Source_Buffer_Ptr_Var); pragma Warnings (On); - Tmp1 : Source_Buffer_Ptr; + Tmp1 : Source_Buffer_Ptr_Var; begin if S.Instance /= No_Instance_Id then @@ -903,7 +908,7 @@ package body Sinput is -- from the zero origin pointer stored in the source table. Tmp1 := - To_Source_Buffer_Ptr + To_Source_Buffer_Ptr_Var (S.Source_Text (S.Source_First)'Address); Free_Ptr (Tmp1); @@ -1254,29 +1259,17 @@ package body Sinput is function Source_First (S : SFI) return Source_Ptr is begin - if S = Internal_Source_File then - return Internal_Source'First; - else - return Source_File.Table (S).Source_First; - end if; + return Source_File.Table (S).Source_First; end Source_First; function Source_Last (S : SFI) return Source_Ptr is begin - if S = Internal_Source_File then - return Internal_Source'Last; - else - return Source_File.Table (S).Source_Last; - end if; + return Source_File.Table (S).Source_Last; end Source_Last; function Source_Text (S : SFI) return Source_Buffer_Ptr is begin - if S = Internal_Source_File then - return Internal_Source_Ptr; - else - return Source_File.Table (S).Source_Text; - end if; + return Source_File.Table (S).Source_Text; end Source_Text; function Template (S : SFI) return SFI is diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index ef7f388..fc700d1 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -451,18 +451,6 @@ package Sinput is Source : Source_Buffer_Ptr; -- Current source (copy of Source_File.Table (Current_Source_Unit).Source) - Internal_Source : aliased Source_Buffer (1 .. 81); - -- This buffer is used internally in the compiler when the lexical analyzer - -- is used to scan a string from within the compiler. The procedure is to - -- establish Internal_Source_Ptr as the value of Source, set the string to - -- be scanned, appropriately terminated, in this buffer, and set Scan_Ptr - -- to point to the start of the buffer. It is a fatal error if the scanner - -- signals an error while scanning a token in this internal buffer. - - Internal_Source_Ptr : constant Source_Buffer_Ptr := - Internal_Source'Unrestricted_Access; - -- Pointer to internal source buffer - ----------------------------------------- -- Handling of Source Line Terminators -- ----------------------------------------- diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index cb12a28..0c5170a 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -169,7 +169,7 @@ package body Targparm is Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); - if Text = null then + if Null_Source_Buffer_Ptr (Text) then Write_Line ("fatal error, run-time library not installed correctly"); Write_Line ("cannot locate file system.ads"); raise Unrecoverable_Error; diff --git a/gcc/ada/types.adb b/gcc/ada/types.adb index 67d15cf..1a4e949 100644 --- a/gcc/ada/types.adb +++ b/gcc/ada/types.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -210,6 +210,15 @@ package body Types is TS (14) := Character'Val (Z + Seconds mod 10); end Make_Time_Stamp; + ---------------------------- + -- Null_Source_Buffer_Ptr -- + ---------------------------- + + function Null_Source_Buffer_Ptr (X : Source_Buffer_Ptr) return Boolean is + begin + return Source_Buffer_Ptr_Equal (X, null); + end Null_Source_Buffer_Ptr; + ---------------------- -- Split_Time_Stamp -- ---------------------- diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 8df9ff1..6180541 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, 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- -- @@ -200,7 +200,7 @@ package Types is -- This is a virtual type used as the designated type of the access type -- Source_Buffer_Ptr, see Osint.Read_Source_File for details. - type Source_Buffer_Ptr is access all Big_Source_Buffer; + type Source_Buffer_Ptr is access constant Big_Source_Buffer; -- Pointer to source buffer. We use virtual origin addressing for source -- buffers, with thin pointers. The pointer points to a virtual instance -- of type Big_Source_Buffer, where the actual type is in fact of type @@ -210,6 +210,21 @@ package Types is -- this type, but we don't give a storage size clause of zero, since we -- may end up doing deallocations of instances allocated manually. + function Null_Source_Buffer_Ptr (X : Source_Buffer_Ptr) return Boolean; + -- True if X = null. ???This usage of "=" is wrong, because the zero-origin + -- pointer could happen to be equal to null. We need to eliminate this. + + function Source_Buffer_Ptr_Equal (X, Y : Source_Buffer_Ptr) return Boolean + renames "="; + -- Squirrel away the predefined "=", for use in Null_Source_Buffer_Ptr. + -- Do not call this elsewhere. + + function "=" (X, Y : Source_Buffer_Ptr) return Boolean is abstract; + -- Make "=" abstract, to make sure noone calls it. Note that this makes + -- "/=" abstract as well. Calls to "=" on Source_Buffer_Ptr are always + -- wrong, because two different arrays allocated at two different addresses + -- can have the same virtual origin. + subtype Source_Ptr is Text_Ptr; -- Type used to represent a source location, which is a subscript of a -- character in the source buffer. As noted above, different source buffers @@ -568,11 +583,6 @@ package Types is type Source_File_Index is new Int range -1 .. Int'Last; -- Type used to index the source file table (see package Sinput) - Internal_Source_File : constant Source_File_Index := - Source_File_Index'First; - -- Value used to indicate the buffer for the source-code-like strings - -- internally created withing the compiler (see package Sinput) - No_Source_File : constant Source_File_Index := 0; -- Value used to indicate no source file present diff --git a/gcc/ada/types.h b/gcc/ada/types.h index c207235..6c14f19 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2016, Free Software Foundation, Inc. * + * Copyright (C) 1992-2017, 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- * @@ -97,7 +97,7 @@ typedef struct { const char *Array; String_Template *Bounds; } inlined stuff IN the C header changes the dependencies. Both sinfo.h and einfo.h now reference routines defined in tree.h. - Note: these types would more naturally be defined as unsigned char, but + Note: these types would more naturally be defined as unsigned char, but once again, the annoying restriction on bit fields for some compilers bites us! */ |