diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/back_end.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 66 | ||||
| -rw-r--r-- | gcc/ada/fmap.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/fname-sf.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/g-dyntab.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/g-table.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/s-carsi8.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-carun8.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-strcom.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/table.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/types.ads | 14 |
11 files changed, 93 insertions, 80 deletions
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index a943b3aa4eb..a6600764988 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -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 diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 106af0aa5ca..d898a306d67 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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; diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 8f286b3b6f7..b09a5248b88 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -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 diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb index c5ed3060e5a..f967c1658b9 100644 --- a/gcc/ada/fname-sf.adb +++ b/gcc/ada/fname-sf.adb @@ -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); diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads index 8c1e112669a..7768c88cd38 100644 --- a/gcc/ada/g-dyntab.ads +++ b/gcc/ada/g-dyntab.ads @@ -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 diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index ae64b8589c1..b0aad3d44aa 100644 --- a/gcc/ada/g-table.ads +++ b/gcc/ada/g-table.ads @@ -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. diff --git a/gcc/ada/s-carsi8.adb b/gcc/ada/s-carsi8.adb index 4f41cdbc1b9..34c9a118170 100644 --- a/gcc/ada/s-carsi8.adb +++ b/gcc/ada/s-carsi8.adb @@ -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 diff --git a/gcc/ada/s-carun8.adb b/gcc/ada/s-carun8.adb index d6f43f10cb9..79343aa092b 100644 --- a/gcc/ada/s-carun8.adb +++ b/gcc/ada/s-carun8.adb @@ -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 diff --git a/gcc/ada/s-strcom.adb b/gcc/ada/s-strcom.adb index 7a1daa7a6ce..00346439998 100644 --- a/gcc/ada/s-strcom.adb +++ b/gcc/ada/s-strcom.adb @@ -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 diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 983f7fd0e35..ff6926f145f 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -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; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 61318c8bcb8..dcaec5f4221 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -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 |
