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>
* exp_util.ads (Expression_Contains_Primitives_Calls_Of): New
......
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
......
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
......
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
......
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
......
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 ("""");
......
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.
......
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
......
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;
......
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
......
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
......
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;
......
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
......
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 --
-----------------------------------------
......
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;
......
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 --
----------------------
......
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
......
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! */
......
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