OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

back_end.adb: Remove Big_String_Ptr declarations (now in Types)

Browse Source 
2008-04-08  Robert Dewar  <dewar@adacore.com>

	* back_end.adb: Remove Big_String_Ptr declarations (now in Types)

	* errout.adb: Remove Big_String_Ptr declarations (now in Types)
	Change name Is_Style_Msg to Is_Style_Or_Info_Msg

	* fmap.adb: Remove Big_String declarations (now in Types)
	(No_Mapping_File): New Boolean global variable
	(Initialize): When mapping file cannot be read, set No_Mapping_File to
	False.
	(Update_Mapping_File): Do nothing if No_Mapping_File is True. If the
	tables were empty before adding entries, open the mapping file
	with Truncate = True, instead of delete/re-create.

	* fname-sf.adb: Remove Big_String declarations (now in Types)

	* s-strcom.adb, g-dyntab.ads, g-table.ads, s-carsi8.adb,
        s-stalib.ads, s-carun8.adb: Add zero size Storage_Size clauses for big
	pointer types

	* table.ads: Add for Table_Ptr'Storage_Size use 0

	* types.ads: Add Big_String declarations
	Add Size_Clause of zero for big pointer types

From-SVN: r134022
This commit is contained in:
Robert Dewar 2008-04-08 08:48:30 +02:00 committed by Arnaud Charlet
parent 2d7756fa26
commit a1e2130ca1
11 changed files with 93 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/back_end.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
@ -125,10 +125,7 @@ package body Back_End is
procedure Scan_Compiler_Arguments is
Next_Arg : Pos := 1;
subtype Big_String is String (Positive);
type BSP is access Big_String;
type Arg_Array is array (Nat) of BSP;
type Arg_Array is array (Nat) of Big_String_Ptr;
type Arg_Array_Ptr is access Arg_Array;
flag_stack_check : Int;
@ -235,9 +232,10 @@ package body Back_End is
while Next_Arg < save_argc loop
Look_At_Arg : declare
Argv_Ptr : constant BSP := save_argv (Next_Arg);
Argv_Len : constant Nat := Len_Arg (Next_Arg);
Argv : constant String := Argv_Ptr (1 .. Natural (Argv_Len));
Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
Argv_Len : constant Nat := Len_Arg (Next_Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
begin
-- If the previous switch has set the Output_File_Name_Present

66
gcc/ada/errout.adb
View File

@ -50,8 +50,6 @@ with Stand; use Stand;
with Style;
with Uname; use Uname;
with Unchecked_Conversion;
package body Errout is
Errors_Must_Be_Ignored : Boolean := False;
@ -797,7 +795,8 @@ package body Errout is
-- If error message line length set, and this is a continuation message
-- then all we do is to append the text to the text of the last message
-- with a comma space separator.
-- with a comma space separator (eliminating a possible (style) or
-- info prefix).
if Error_Msg_Line_Length /= 0
and then Continuation
@ -808,6 +807,7 @@ package body Errout is
Oldm : String_Ptr := Errors.Table (Cur_Msg).Text;
Newm : String (1 .. Oldm'Last + 2 + Msglen);
Newl : Natural;
M : Natural;
begin
-- First copy old message to new one and free it
@ -816,6 +816,16 @@ package body Errout is
Newl := Oldm'Length;
Free (Oldm);
-- Remove (style) or info: at start of message
if Msglen > 8 and then Msg_Buffer (1 .. 8) = "(style) " then
M := 9;
elsif Msglen > 6 and then Msg_Buffer (1 .. 6) = "info: " then
M := 7;
else
M := 1;
end if;
-- Now deal with separation between messages. Normally this
-- is simply comma space, but there are some special cases.
@ -830,16 +840,16 @@ package body Errout is
-- successive parenthetical remarks into a single one with
-- separating commas).
elsif Msg_Buffer (1) = '(' and then Msg_Buffer (Msglen) = ')' then
elsif Msg_Buffer (M) = '(' and then Msg_Buffer (Msglen) = ')' then
-- Case where existing message ends in right paren, remove
-- and separate parenthetical remarks with a comma.
if Newm (Newl) = ')' then
Newm (Newl) := ',';
Msg_Buffer (1) := ' ';
Msg_Buffer (M) := ' ';
-- Case where we are adding new parenthetical comment
-- Case where we are adding new parenthetical comment
else
Newl := Newl + 1;
@ -855,8 +865,9 @@ package body Errout is
-- Append new message
Newm (Newl + 1 .. Newl + Msglen) := Msg_Buffer (1 .. Msglen);
Newl := Newl + Msglen;
Newm (Newl + 1 .. Newl + Msglen - M + 1) :=
Msg_Buffer (M .. Msglen);
Newl := Newl + Msglen - M + 1;
Errors.Table (Cur_Msg).Text := new String'(Newm (1 .. Newl));
end;
@ -956,9 +967,9 @@ package body Errout is
and then Compiler_State = Parsing
and then not All_Errors_Mode
then
-- Don't delete unconditional messages and at this stage,
-- don't delete continuation lines (we attempted to delete
-- those earlier if the parent message was deleted.
-- Don't delete unconditional messages and at this stage, don't
-- delete continuation lines (we attempted to delete those earlier
-- if the parent message was deleted.
if not Errors.Table (Cur_Msg).Uncond
and then not Continuation
@ -1011,10 +1022,9 @@ package body Errout is
-- Bump appropriate statistics count
if Errors.Table (Cur_Msg).Warn
or else Errors.Table (Cur_Msg).Style
then
if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
Warnings_Detected := Warnings_Detected + 1;
else
Total_Errors_Detected := Total_Errors_Detected + 1;
@ -1113,7 +1123,7 @@ package body Errout is
Last_Killed := True;
end if;
if not Is_Warning_Msg and then not Is_Style_Msg then
if not (Is_Warning_Msg or Is_Style_Msg) then
Set_Posted (N);
end if;
end Error_Msg_NEL;
@ -1927,9 +1937,9 @@ package body Errout is
and then Errors.Table (E).Optr = Loc
-- Don't remove if not warning message. Note that we do not
-- remove style messages here. They are warning messages but
-- not ones we want removed in this context.
-- Don't remove if not warning/info message. Note that we do
-- not remove style messages here. They are warning messages
-- but not ones we want removed in this context.
and then Errors.Table (E).Warn
@ -1976,12 +1986,11 @@ package body Errout is
and then Original_Node (N) /= N
and then No (Condition (N))
then
-- Warnings may have been posted on subexpressions of
-- the original tree. We place the original node back
-- on the tree to remove those warnings, whose sloc
-- do not match those of any node in the current tree.
-- Given that we are in unreachable code, this modification
-- to the tree is harmless.
-- Warnings may have been posted on subexpressions of the original
-- tree. We place the original node back on the tree to remove
-- those warnings, whose sloc do not match those of any node in
-- the current tree. Given that we are in unreachable code, this
-- modification to the tree is harmless.
declare
Status : Traverse_Final_Result;
@ -2022,7 +2031,6 @@ package body Errout is
begin
if Is_Non_Empty_List (L) then
Stat := First (L);
while Present (Stat) loop
Remove_Warning_Messages (Stat);
Next (Stat);
@ -2038,12 +2046,6 @@ package body Errout is
(Identifier_Name : System.Address;
File_Name : System.Address)
is
type Big_String is array (Positive) of Character;
type Big_String_Ptr is access all Big_String;
function To_Big_String_Ptr is new Unchecked_Conversion
(System.Address, Big_String_Ptr);
Ident : constant Big_String_Ptr := To_Big_String_Ptr (Identifier_Name);
File : constant Big_String_Ptr := To_Big_String_Ptr (File_Name);
Flen : Natural;
@ -2083,7 +2085,7 @@ package body Errout is
for J in Name_Buffer'Range loop
Name_Buffer (J) := Ident (J);
if Name_Buffer (J) = ASCII.Nul then
if Name_Buffer (J) = ASCII.NUL then
Name_Len := J - 1;
exit;
end if;

31
gcc/ada/fmap.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2008, 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- --
@ -37,8 +37,10 @@ with GNAT.HTable;
package body Fmap is
subtype Big_String is String (Positive);
type Big_String_Ptr is access all Big_String;
No_Mapping_File : Boolean := False;
-- Set to True when the specified mapping file cannot be read in
-- procedure Initialize, so that no attempt is made to oopen the mapping
-- file in procedure Update_Mapping_File.
function To_Big_String_Ptr is new Unchecked_Conversion
(Source_Buffer_Ptr, Big_String_Ptr);
@ -301,6 +303,7 @@ package body Fmap is
Write_Str ("warning: could not read mapping file """);
Write_Str (File_Name);
Write_Line ("""");
No_Mapping_File := True;
else
BS := To_Big_String_Ptr (Src);
@ -479,27 +482,17 @@ package body Fmap is
-- Start of Update_Mapping_File
begin
-- If the mapping file could not be read, then it will not be possible
-- to update it.
if No_Mapping_File then
return;
end if;
-- Only Update if there are new entries in the mappings
if Last_In_Table < File_Mapping.Last then
-- If the tables have been emptied, recreate the file.
-- Otherwise, append to it.
if Last_In_Table = 0 then
declare
Discard : Boolean;
pragma Warnings (Off, Discard);
begin
Delete_File (File_Name, Discard);
end;
File := Create_File (File_Name, Binary);
else
File := Open_Read_Write (Name => File_Name, Fmode => Binary);
end if;
File := Open_Read_Write (Name => File_Name, Fmode => Binary);
if File /= Invalid_FD then
if Last_In_Table > 0 then

5
gcc/ada/fname-sf.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
@ -34,9 +34,6 @@ with Unchecked_Conversion;
package body Fname.SF is
subtype Big_String is String (Positive);
type Big_String_Ptr is access all Big_String;
function To_Big_String_Ptr is new Unchecked_Conversion
(Source_Buffer_Ptr, Big_String_Ptr);

18
gcc/ada/g-dyntab.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2006, AdaCore --
-- Copyright (C) 2000-2008, AdaCore --
-- --
-- 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- --
@ -91,17 +91,19 @@ package GNAT.Dynamic_Tables is
type Table_Type is
array (Table_Index_Type range <>) of Table_Component_Type;
subtype Big_Table_Type is
Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
-- We work with pointers to a bogus array type that is constrained
-- with the maximum possible range bound. This means that the pointer
-- is a thin pointer, which is more efficient. Since subscript checks
-- in any case must be on the logical, rather than physical bounds,
-- safety is not compromised by this approach.
-- We work with pointers to a bogus array type that is constrained with
-- the maximum possible range bound. This means that the pointer is a thin
-- pointer, which is more efficient. Since subscript checks in any case
-- must be on the logical, rather than physical bounds, safety is not
-- compromised by this approach. These types should not be used by the
-- client.
type Table_Ptr is access all Big_Table_Type;
-- The table is actually represented as a pointer to allow reallocation
for Table_Ptr'Storage_Size use 0;
-- The table is actually represented as a pointer to allow reallocation.
-- This type should not be used by the client.
type Table_Private is private;
-- Table private data that is not exported in Instance

10
gcc/ada/g-table.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2007, AdaCore --
-- Copyright (C) 1998-2008, AdaCore --
-- --
-- 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- --
@ -105,17 +105,19 @@ package GNAT.Table is
type Table_Type is
array (Table_Index_Type range <>) of Table_Component_Type;
subtype Big_Table_Type is
Table_Type (Table_Low_Bound .. Table_Index_Type'Last);
-- We work with pointers to a bogus array type that is constrained
-- with the maximum possible range bound. This means that the pointer
-- is a thin pointer, which is more efficient. Since subscript checks
-- in any case must be on the logical, rather than physical bounds,
-- safety is not compromised by this approach.
-- safety is not compromised by this approach. These types should never
-- be used by the client.
type Table_Ptr is access all Big_Table_Type;
-- The table is actually represented as a pointer to allow reallocation
for Table_Ptr'Storage_Size use 0;
-- The table is actually represented as a pointer to allow reallocation.
-- This type should never be used by the client.
Table : aliased Table_Ptr := null;
-- The table itself. The lower bound is the value of Low_Bound.

4
gcc/ada/s-carsi8.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2008, 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,6 +42,7 @@ package body System.Compare_Array_Signed_8 is
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is range -128 .. +127;
@ -50,6 +51,7 @@ package body System.Compare_Array_Signed_8 is
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new

4
gcc/ada/s-carun8.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2008, 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- --
@ -46,6 +46,7 @@ package body System.Compare_Array_Unsigned_8 is
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is mod 2 ** 8;
@ -53,6 +54,7 @@ package body System.Compare_Array_Unsigned_8 is
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new

4
gcc/ada/s-strcom.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2002-2008, 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- --
@ -44,6 +44,7 @@ package body System.String_Compare is
type Big_Words is array (Natural) of Word;
type Big_Words_Ptr is access Big_Words;
for Big_Words_Ptr'Storage_Size use 0;
-- Array type used to access by words
type Byte is mod 2 ** 8;
@ -51,6 +52,7 @@ package body System.String_Compare is
type Big_Bytes is array (Natural) of Byte;
type Big_Bytes_Ptr is access Big_Bytes;
for Big_Bytes_Ptr'Storage_Size use 0;
-- Array type used to access by bytes
function To_Big_Words is new

3
gcc/ada/table.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
@ -117,6 +117,7 @@ package Table is
-- safety is not compromised by this approach.
type Table_Ptr is access all Big_Table_Type;
for Table_Ptr'Storage_Size use 0;
-- The table is actually represented as a pointer to allow reallocation
Table : aliased Table_Ptr := null;

14
gcc/ada/types.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2008, 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- --
@ -47,6 +47,8 @@
-- 2s-complement. If there are any machines for which this is not a correct
-- assumption, a significant number of changes will be required!
with System;
with Unchecked_Conversion;
with Unchecked_Deallocation;
package Types is
@ -123,6 +125,15 @@ package Types is
procedure Free is new Unchecked_Deallocation (String, String_Ptr);
-- Procedure for freeing dynamically allocated String values
subtype Big_String is String (Positive);
type Big_String_Ptr is access all Big_String;
for Big_String_Ptr'Storage_Size use 0;
-- Virtual type for handling imported big strings
function To_Big_String_Ptr is
new Unchecked_Conversion (System.Address, Big_String_Ptr);
-- Used to obtain Big_String_Ptr values from external addresses
subtype Word_Hex_String is String (1 .. 8);
-- Type used to represent Word value as 8 hex digits, with lower case
-- letters for the alphabetic cases.
@ -191,6 +202,7 @@ package Types is
-- type Source_Buffer_Ptr, see Osint.Read_Source_File for details.
type Source_Buffer_Ptr is access all Big_Source_Buffer;
for Source_Buffer_Ptr'Storage_Size use 0;
-- 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