+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
-- 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
-- --
-- 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- --
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;
-- 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
-- --
-- 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- --
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
-- --
-- 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- --
-- 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
-- --
-- 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- --
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 ("""");
-- --
-- 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- --
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.
-- --
-- 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- --
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
-- --
-- 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- --
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;
-- --
-- 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- --
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
-- 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
-- --
-- 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- --
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
-- --
-- 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- --
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;
-- --
-- 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- --
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
-- 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);
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
-- --
-- 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- --
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 --
-----------------------------------------
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;
-- --
-- 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- --
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 --
----------------------
-- --
-- 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- --
-- 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
-- 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
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
* *
* 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- *
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! */
git://gcc.gnu.org / gcc.git / commitdiff