Skip to content

R
riscv-gcc-1
Commit 0f96fd14 by Bob Duff Committed by Arnaud Charlet
Options

err_vars.ads, [...]: Eliminate the vestigial Internal_Source_File and the Internal_Source buffer. 

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.

From-SVN: r247234
parent 7d5dbb22
Showing with 81 additions and 98 deletions
gcc/ada/ChangeLog
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> 2017-04-25 Claire Dross <dross@adacore.com>
* exp_util.ads (Expression_Contains_Primitives_Calls_Of): New * exp_util.ads (Expression_Contains_Primitives_Calls_Of): New
......
gcc/ada/comperr.adb
...@@ -265,7 +265,7 @@ package body Comperr is ...@@ -265,7 +265,7 @@ package body Comperr is
-- If we get a Src file, we use it -- If we get a Src file, we use it
if Src /= null then if not Null_Source_Buffer_Ptr (Src) then
Lo := 0; Lo := 0;
Outer : while Lo < Hi loop Outer : while Lo < Hi loop
......
gcc/ada/cstand.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -38,7 +38,6 @@ with Set_Targ; use Set_Targ; ...@@ -38,7 +38,6 @@ with Set_Targ; use Set_Targ;
with Targparm; use Targparm; with Targparm; use Targparm;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Ttypes; use Ttypes; with Ttypes; use Ttypes;
with Scn;
with Sem_Mech; use Sem_Mech; with Sem_Mech; use Sem_Mech;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -582,10 +581,6 @@ package body CStand is ...@@ -582,10 +581,6 @@ package body CStand is
-- Start of processing for Create_Standard -- Start of processing for Create_Standard
begin 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 -- First step is to create defining identifiers for each entity
for S in Standard_Entity_Type loop for S in Standard_Entity_Type loop
......
gcc/ada/err_vars.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -80,7 +80,7 @@ package Err_Vars is ...@@ -80,7 +80,7 @@ package Err_Vars is
Error_Msg_Exception : exception; Error_Msg_Exception : exception;
-- Exception raised if Raise_Exception_On_Error is true -- 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 -- 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 -- 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 -- means that no file names will be output unless there are errors in units
......
gcc/ada/errout.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -312,11 +312,6 @@ package body Errout is ...@@ -312,11 +312,6 @@ package body Errout is
-- template in instantiation case, otherwise unchanged). -- template in instantiation case, otherwise unchanged).
begin 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 -- Return if all errors are to be ignored
if Errors_Must_Be_Ignored then if Errors_Must_Be_Ignored then
......
gcc/ada/fmap.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -306,7 +306,7 @@ package body Fmap is ...@@ -306,7 +306,7 @@ package body Fmap is
Name_Buffer (1 .. Name_Len) := File_Name; Name_Buffer (1 .. Name_Len) := File_Name;
Read_Source_File (Name_Enter, 0, Hi, Src, Config); 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 ("warning: could not read mapping file """);
Write_Str (File_Name); Write_Str (File_Name);
Write_Line (""""); Write_Line ("""");
......
gcc/ada/fmap.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,7 +42,7 @@ package Fmap is ...@@ -42,7 +42,7 @@ package Fmap is
procedure Initialize (File_Name : String); procedure Initialize (File_Name : String);
-- Initialize the mappings from the mapping file File_Name. -- 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. -- duplicate entries), output a warning and do not initialize the mappings.
-- Record the state of the mapping tables in case Update is called -- Record the state of the mapping tables in case Update is called
-- later on. -- later on.
......
gcc/ada/fname-sf.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -74,7 +74,7 @@ package body Fname.SF is ...@@ -74,7 +74,7 @@ package body Fname.SF is
Name_Len := 8; Name_Len := 8;
Read_Source_File (Name_Enter, 0, Hi, Src); 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); BS := To_Big_String_Ptr (Src);
SP := BS (1 .. Natural (Hi))'Unrestricted_Access; SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
Scan_SFN_Pragmas Scan_SFN_Pragmas
......
gcc/ada/gnatls.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1653,7 +1653,7 @@ begin ...@@ -1653,7 +1653,7 @@ begin
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); 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; No_Runtime := True;
end if; end if;
end; end;
......
gcc/ada/scn.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -209,21 +209,14 @@ package body Scn is ...@@ -209,21 +209,14 @@ package body Scn is
begin begin
Scanner.Initialize_Scanner (Index); Scanner.Initialize_Scanner (Index);
Set_Unit (Index, Unit);
if Index /= Internal_Source_File then
Set_Unit (Index, Unit);
end if;
Current_Source_Unit := Unit; Current_Source_Unit := Unit;
-- Set default for Comes_From_Source (except if we are going to process -- Set default for Comes_From_Source. All nodes built now until we
-- an artificial string internally created within the compiler and
-- placed into internal source duffer). All nodes built now until we
-- reenter the analyzer will have Comes_From_Source set to True -- reenter the analyzer will have Comes_From_Source set to True
if Index /= Internal_Source_File then Set_Comes_From_Source_Default (True);
Set_Comes_From_Source_Default (True);
end if;
-- Check license if GNAT type header possibly present -- Check license if GNAT type header possibly present
...@@ -239,19 +232,7 @@ package body Scn is ...@@ -239,19 +232,7 @@ package body Scn is
-- call Scan. Scan initial token (note this initializes Prev_Token, -- call Scan. Scan initial token (note this initializes Prev_Token,
-- Prev_Token_Ptr). -- Prev_Token_Ptr).
-- There are two reasons not to do the Scan step in case if we Scan;
-- 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;
-- Clear flags for reserved words used as identifiers -- Clear flags for reserved words used as identifiers
......
gcc/ada/scn.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,9 +39,9 @@ package Scn is ...@@ -39,9 +39,9 @@ package Scn is
Index : Source_File_Index); Index : Source_File_Index);
-- Initialize lexical scanner for scanning a new file. The caller has -- Initialize lexical scanner for scanning a new file. The caller has
-- completed the construction of the Units.Table entry for the specified -- completed the construction of the Units.Table entry for the specified
-- Unit and Index references the corresponding source file. A special -- Unit and Index references the corresponding source file. A special case
-- case is when Unit = No_Unit_Number, and Index corresponds to the -- is when Unit = No_Unit, and Index corresponds to the source index for
-- source index for reading the configuration pragma file. -- reading the configuration pragma file.
function Determine_Token_Casing return Casing_Type; function Determine_Token_Casing return Casing_Type;
-- Determines the casing style of the current token, which is either a -- Determines the casing style of the current token, which is either a
......
gcc/ada/sinput-l.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -416,7 +416,7 @@ package body Sinput.L is ...@@ -416,7 +416,7 @@ package body Sinput.L is
Osint.Read_Source_File (N, Lo, Hi, Src, T); Osint.Read_Source_File (N, Lo, Hi, Src, T);
if Src = null then if Null_Source_Buffer_Ptr (Src) then
Source_File.Decrement_Last; Source_File.Decrement_Last;
return No_Source_File; return No_Source_File;
......
gcc/ada/sinput.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -876,19 +876,24 @@ package body Sinput is ...@@ -876,19 +876,24 @@ package body Sinput is
declare declare
S : Source_File_Record renames Source_File.Table (J); 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 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); pragma Warnings (Off);
-- This unchecked conversion is aliasing safe, since it is not -- This unchecked conversion is aliasing safe, since it is not
-- used to create improperly aliased pointer values. -- used to create improperly aliased pointer values.
function To_Source_Buffer_Ptr is new function To_Source_Buffer_Ptr_Var is new
Unchecked_Conversion (Address, Source_Buffer_Ptr); Unchecked_Conversion (Address, Source_Buffer_Ptr_Var);
pragma Warnings (On); pragma Warnings (On);
Tmp1 : Source_Buffer_Ptr; Tmp1 : Source_Buffer_Ptr_Var;
begin begin
if S.Instance /= No_Instance_Id then if S.Instance /= No_Instance_Id then
...@@ -903,7 +908,7 @@ package body Sinput is ...@@ -903,7 +908,7 @@ package body Sinput is
-- from the zero origin pointer stored in the source table. -- from the zero origin pointer stored in the source table.
Tmp1 := Tmp1 :=
To_Source_Buffer_Ptr To_Source_Buffer_Ptr_Var
(S.Source_Text (S.Source_First)'Address); (S.Source_Text (S.Source_First)'Address);
Free_Ptr (Tmp1); Free_Ptr (Tmp1);
...@@ -1254,29 +1259,17 @@ package body Sinput is ...@@ -1254,29 +1259,17 @@ package body Sinput is
function Source_First (S : SFI) return Source_Ptr is function Source_First (S : SFI) return Source_Ptr is
begin begin
if S = Internal_Source_File then return Source_File.Table (S).Source_First;
return Internal_Source'First;
else
return Source_File.Table (S).Source_First;
end if;
end Source_First; end Source_First;
function Source_Last (S : SFI) return Source_Ptr is function Source_Last (S : SFI) return Source_Ptr is
begin begin
if S = Internal_Source_File then return Source_File.Table (S).Source_Last;
return Internal_Source'Last;
else
return Source_File.Table (S).Source_Last;
end if;
end Source_Last; end Source_Last;
function Source_Text (S : SFI) return Source_Buffer_Ptr is function Source_Text (S : SFI) return Source_Buffer_Ptr is
begin begin
if S = Internal_Source_File then return Source_File.Table (S).Source_Text;
return Internal_Source_Ptr;
else
return Source_File.Table (S).Source_Text;
end if;
end Source_Text; end Source_Text;
function Template (S : SFI) return SFI is function Template (S : SFI) return SFI is
......
gcc/ada/sinput.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -451,18 +451,6 @@ package Sinput is ...@@ -451,18 +451,6 @@ package Sinput is
Source : Source_Buffer_Ptr; Source : Source_Buffer_Ptr;
-- Current source (copy of Source_File.Table (Current_Source_Unit).Source) -- 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 -- -- Handling of Source Line Terminators --
----------------------------------------- -----------------------------------------
......
gcc/ada/targparm.adb
...@@ -169,7 +169,7 @@ package body Targparm is ...@@ -169,7 +169,7 @@ package body Targparm is
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); 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 ("fatal error, run-time library not installed correctly");
Write_Line ("cannot locate file system.ads"); Write_Line ("cannot locate file system.ads");
raise Unrecoverable_Error; raise Unrecoverable_Error;
......
gcc/ada/types.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -210,6 +210,15 @@ package body Types is ...@@ -210,6 +210,15 @@ package body Types is
TS (14) := Character'Val (Z + Seconds mod 10); TS (14) := Character'Val (Z + Seconds mod 10);
end Make_Time_Stamp; 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 -- -- Split_Time_Stamp --
---------------------- ----------------------
......
gcc/ada/types.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -200,7 +200,7 @@ package Types is ...@@ -200,7 +200,7 @@ package Types is
-- This is a virtual type used as the designated type of the access type -- This is a virtual type used as the designated type of the access type
-- Source_Buffer_Ptr, see Osint.Read_Source_File for details. -- 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 -- Pointer to source buffer. We use virtual origin addressing for source
-- buffers, with thin pointers. The pointer points to a virtual instance -- 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 -- of type Big_Source_Buffer, where the actual type is in fact of type
...@@ -210,6 +210,21 @@ package Types is ...@@ -210,6 +210,21 @@ package Types is
-- this type, but we don't give a storage size clause of zero, since we -- this type, but we don't give a storage size clause of zero, since we
-- may end up doing deallocations of instances allocated manually. -- 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; subtype Source_Ptr is Text_Ptr;
-- Type used to represent a source location, which is a subscript of a -- Type used to represent a source location, which is a subscript of a
-- character in the source buffer. As noted above, different source buffers -- character in the source buffer. As noted above, different source buffers
...@@ -568,11 +583,6 @@ package Types is ...@@ -568,11 +583,6 @@ package Types is
type Source_File_Index is new Int range -1 .. Int'Last; type Source_File_Index is new Int range -1 .. Int'Last;
-- Type used to index the source file table (see package Sinput) -- 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; No_Source_File : constant Source_File_Index := 0;
-- Value used to indicate no source file present -- Value used to indicate no source file present
......
gcc/ada/types.h
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * 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 * * 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- * * 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; } ...@@ -97,7 +97,7 @@ typedef struct { const char *Array; String_Template *Bounds; }
inlined stuff IN the C header changes the dependencies. Both sinfo.h inlined stuff IN the C header changes the dependencies. Both sinfo.h
and einfo.h now reference routines defined in tree.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 once again, the annoying restriction on bit fields for some compilers
bites us! */ bites us! */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment