2011-08-02 Robert Dewar <dewar@adacore.com>

	* a-direct.adb, sinfo.ads, exp_ch9.adb, scng.adb, sem_util.adb,
	sem_util.ads, restrict.ads, par-prag.adb: Minor reformatting and/or
	code reorganization.

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Debug flag d.P to suppress length comparison optimization
	* exp_ch4.adb (Optimize_Length_Comparison): New routine to optimize
	comparison of Length by comparing First/Last instead.

2011-08-02  Matthew Heaney  <heaney@adacore.com>

	* a-cobove.ads: Code clean up.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177190 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 504 insertions, 53 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bafa761e5eb..a911edaab6d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+	* a-direct.adb, sinfo.ads, exp_ch9.adb, scng.adb, sem_util.adb,
+	sem_util.ads, restrict.ads, par-prag.adb: Minor reformatting and/or
+	code reorganization.
+
+2011-08-02  Robert Dewar  <dewar@adacore.com>
+
+	* debug.adb: Debug flag d.P to suppress length comparison optimization
+	* exp_ch4.adb (Optimize_Length_Comparison): New routine to optimize
+	comparison of Length by comparing First/Last instead.
+
+2011-08-02  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cobove.ads: Code clean up.
+
 2011-08-02  Vincent Celier  <celier@adacore.com>
 
 	* adaint.c (file_names_case_sensitive_cache): New static int.
diff --git a/gcc/ada/a-cobove.ads b/gcc/ada/a-cobove.ads
index 30dc9aabfba..9fc7945da86 100644
--- a/gcc/ada/a-cobove.ads
+++ b/gcc/ada/a-cobove.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -322,7 +322,7 @@ private
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
    type Vector (Capacity : Count_Type) is tagged record
-      Elements : Elements_Array (1 .. Capacity);
+      Elements : Elements_Array (1 .. Capacity) := (others => <>);
       Last     : Extended_Index := No_Index;
       Busy     : Natural := 0;
       Lock     : Natural := 0;
diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index 81b8dd5e860..6bb499ee2e8 100644
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -39,23 +39,23 @@ with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 
-with System.CRTL;    use System.CRTL;
-with System.OS_Constants;
-with System.OS_Lib;  use System.OS_Lib;
-with System.Regexp;  use System.Regexp;
-with System.File_IO; use System.File_IO;
-with System;
+with System.CRTL;         use System.CRTL;
+with System.OS_Constants; use System.OS_Constants;
+with System.OS_Lib;       use System.OS_Lib;
+with System.Regexp;       use System.Regexp;
+with System.File_IO;      use System.File_IO;
+with System;              use System;
 
 package body Ada.Directories is
 
    Filename_Max : constant Integer := 1024;
    --  1024 is the value of FILENAME_MAX in stdio.h
 
-   type Dir_Type_Value is new System.Address;
+   type Dir_Type_Value is new Address;
    --  This is the low-level address directory structure as returned by the C
    --  opendir routine.
 
-   No_Dir : constant Dir_Type_Value := Dir_Type_Value (System.Null_Address);
+   No_Dir : constant Dir_Type_Value := Dir_Type_Value (Null_Address);
 
    Dir_Separator : constant Character;
    pragma Import (C, Dir_Separator, "__gnat_dir_separator");
@@ -384,7 +384,7 @@ package body Ada.Directories is
             end;
          end if;
 
-         --  The implementation uses System.OS_Lib.Copy_File
+         --  Do actual copy using System.OS_Lib.Copy_File
 
          Copy_File (Source_Name, Target_Name, Success, Mode, Preserve);
 
@@ -496,9 +496,7 @@ package body Ada.Directories is
       Path_Len : Natural := Max_Path;
       Buffer   : String (1 .. 1 + Max_Path + 1);
 
-      procedure Local_Get_Current_Dir
-        (Dir    : System.Address;
-         Length : System.Address);
+      procedure Local_Get_Current_Dir (Dir : Address; Length : Address);
       pragma Import (C, Local_Get_Current_Dir, "__gnat_get_current_dir");
 
    begin
@@ -563,7 +561,7 @@ package body Ada.Directories is
          raise Name_Error with "file """ & Name & """ does not exist";
 
       else
-         --  The implementation uses System.OS_Lib.Delete_File
+         --  Do actual deletion using System.OS_Lib.Delete_File
 
          Delete_File (Name, Success);
 
@@ -602,7 +600,7 @@ package body Ada.Directories is
                File_Name : constant String := Simple_Name (Dir_Ent);
 
             begin
-               if System.OS_Lib.Is_Directory (File_Name) then
+               if OS_Lib.Is_Directory (File_Name) then
                   if File_Name /= "." and then File_Name /= ".." then
                      Delete_Tree (File_Name);
                   end if;
@@ -698,7 +696,7 @@ package body Ada.Directories is
       Kind : File_Kind := Ordinary_File;
       --  Initialized to avoid a compilation warning
 
-      Filename_Addr : System.Address;
+      Filename_Addr : Address;
       Filename_Len  : aliased Integer;
 
       Buffer : array (0 .. Filename_Max + 12) of Character;
@@ -706,26 +704,24 @@ package body Ada.Directories is
       --  field for the filename.
 
       function readdir_gnat
-        (Directory : System.Address;
-         Buffer    : System.Address;
-         Last      : not null access Integer) return System.Address;
+        (Directory : Address;
+         Buffer    : Address;
+         Last      : not null access Integer) return Address;
       pragma Import (C, readdir_gnat, "__gnat_readdir");
 
-      use System;
-
    begin
       --  Search.Value.Is_Valid is always True when Fetch_Next_Entry is called
 
       loop
          Filename_Addr :=
            readdir_gnat
-             (System.Address (Search.Value.Dir),
+             (Address (Search.Value.Dir),
               Buffer'Address,
               Filename_Len'Access);
 
          --  If no matching entry is found, set Is_Valid to False
 
-         if Filename_Addr = System.Null_Address then
+         if Filename_Addr = Null_Address then
             Search.Value.Is_Valid := False;
             exit;
          end if;
@@ -801,7 +797,7 @@ package body Ada.Directories is
    -----------------
 
    function File_Exists (Name : String) return Boolean is
-      function C_File_Exists (A : System.Address) return Integer;
+      function C_File_Exists (A : Address) return Integer;
       pragma Import (C, C_File_Exists, "__gnat_file_exists");
 
       C_Name : String (1 .. Name'Length + 1);
@@ -848,9 +844,11 @@ package body Ada.Directories is
 
          declare
             --  We need to resolve links because of A.16(47), since we must not
-            --  return alternative names for files
+            --  return alternative names for files.
+
             Value : constant String := Normalize_Pathname (Name);
             subtype Result is String (1 .. Value'Length);
+
          begin
             return Result (Value);
          end;
@@ -1056,18 +1054,19 @@ package body Ada.Directories is
            & """ designates a file that already exists";
 
       else
-         --  The implementation uses System.OS_Lib.Rename_File
+         --  Do actual rename using System.OS_Lib.Rename_File
 
          Rename_File (Old_Name, New_Name, Success);
 
          if not Success then
+
             --  AI05-0231-1: Name_Error should be raised in case a directory
             --  component of New_Name does not exist (as in New_Name =>
             --  "/no-such-dir/new-filename"). ENOENT indicates that. ENOENT
             --  also indicate that the Old_Name does not exist, but we already
             --  checked for that above. All other errors are Use_Error.
 
-            if Errno = System.OS_Constants.ENOENT then
+            if Errno = ENOENT then
                raise Name_Error with
                  "file """ & Containing_Directory (New_Name) & """ not found";
 
@@ -1154,9 +1153,10 @@ package body Ada.Directories is
          Cut_End := Path'Last;
 
          Check_For_Standard_Dirs : declare
-            BN               : constant String := Path (Cut_Start .. Cut_End);
+            BN : constant String := Path (Cut_Start .. Cut_End);
+
             Has_Drive_Letter : constant Boolean :=
-                                 System.OS_Lib.Path_Separator /= ':';
+                                 OS_Lib.Path_Separator /= ':';
             --  If Path separator is not ':' then we are on a DOS based OS
             --  where this character is used as a drive letter separator.
 
@@ -1221,7 +1221,7 @@ package body Ada.Directories is
    function Size (Name : String) return File_Size is
       C_Name : String (1 .. Name'Length + 1);
 
-      function C_Size (Name : System.Address) return Long_Integer;
+      function C_Size (Name : Address) return Long_Integer;
       pragma Import (C, C_Size, "__gnat_named_file_length");
 
    begin
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 8f386093957..65af4de796d 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -133,7 +133,7 @@ package body Debug is
    --  d.M
    --  d.N
    --  d.O  Dump internal SCO tables
-   --  d.P
+   --  d.P  Previous (non-optimized) handling of length comparisons
    --  d.Q
    --  d.R
    --  d.S  Force Optimize_Alignment (Space)
@@ -597,6 +597,11 @@ package body Debug is
    --       the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
    --       are dumped for debugging purposes.
 
+   --  d.P  Previous non-optimized handling of length comparisons. Setting this
+   --       flag inhibits the effect of Optimize_Length_Comparison in Exp_Ch4.
+   --       This is there in case we find a situation where the optimization
+   --       malfunctions, to provide a work around.
+
    --  d.S  Force Optimize_Alignment (Space) mode as the default
 
    --  d.T  Force Optimize_Alignment (Time) mode as the default
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ebf1a381aaa..abaf676b148 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -202,6 +202,12 @@ package body Exp_Ch4 is
    --  constrained type (the caller has ensured this by using
    --  Convert_To_Actual_Subtype if necessary).
 
+   procedure Optimize_Length_Comparison (N : Node_Id);
+   --  Given an expression, if it is of the form X'Length op N (or the other
+   --  way round), where N is known at compile time to be 0 or 1, and X is a
+   --  simple entity, and op is a comparison operator, optimizes it into a
+   --  comparison of First and Last.
+
    procedure Rewrite_Comparison (N : Node_Id);
    --  If N is the node for a comparison whose outcome can be determined at
    --  compile time, then the node N can be rewritten with True or False. If
@@ -3197,9 +3203,9 @@ package body Exp_Ch4 is
          if Inside_A_Return_Statement (N)
            and then
              (Ekind (PtrT) = E_Anonymous_Access_Type
-                or else
-                  (Ekind (PtrT) = E_Access_Type
-                     and then No (Associated_Final_Chain (PtrT))))
+               or else
+                 (Ekind (PtrT) = E_Access_Type
+                   and then No (Associated_Final_Chain (PtrT))))
          then
             declare
                Decl    : Node_Id;
@@ -6055,6 +6061,8 @@ package body Exp_Ch4 is
          Expand_Vax_Comparison (N);
          return;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Eq;
 
    -----------------------
@@ -6415,6 +6423,8 @@ package body Exp_Ch4 is
          Expand_Vax_Comparison (N);
          return;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Ge;
 
    --------------------
@@ -6450,6 +6460,8 @@ package body Exp_Ch4 is
          Expand_Vax_Comparison (N);
          return;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Gt;
 
    --------------------
@@ -6485,6 +6497,8 @@ package body Exp_Ch4 is
          Expand_Vax_Comparison (N);
          return;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Le;
 
    --------------------
@@ -6520,6 +6534,8 @@ package body Exp_Ch4 is
          Expand_Vax_Comparison (N);
          return;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Lt;
 
    -----------------------
@@ -6935,6 +6951,8 @@ package body Exp_Ch4 is
             Analyze_And_Resolve (N, Standard_Boolean);
          end;
       end if;
+
+      Optimize_Length_Comparison (N);
    end Expand_N_Op_Ne;
 
    ---------------------
@@ -10157,6 +10175,397 @@ package body Exp_Ch4 is
       return Func_Body;
    end Make_Boolean_Array_Op;
 
+   --------------------------------
+   -- Optimize_Length_Comparison --
+   --------------------------------
+
+   procedure Optimize_Length_Comparison (N : Node_Id) is
+      Loc    : constant Source_Ptr := Sloc (N);
+      Typ    : constant Entity_Id  := Etype (N);
+      Result : Node_Id;
+
+      Left  : Node_Id;
+      Right : Node_Id;
+      --  First and Last attribute reference nodes, which end up as left and
+      --  right operands of the optimized result.
+
+      Is_Zero : Boolean;
+      --  True for comparison operand of zero
+
+      Comp : Node_Id;
+      --  Comparison operand, set only if Is_Zero is false
+
+      Ent : Entity_Id;
+      --  Entity whose length is being compared
+
+      Index : Node_Id;
+      --  Integer_Literal node for length attribute expression, or Empty
+      --  if there is no such expression present.
+
+      Ityp  : Entity_Id;
+      --  Type of array index to which 'Length is applied
+
+      Op : Node_Kind := Nkind (N);
+      --  Kind of comparison operator, gets flipped if operands backwards
+
+      function Is_Optimizable (N : Node_Id) return Boolean;
+      --  Tests N to see if it is an optimizable comparison value (defined
+      --  as constant zero or one, or something else where the value is known
+      --  to be in range of 32-bits, and where the corresponding Length value
+      --  is also known to be 32-bits. If result is true, sets Is_Zero, Ityp,
+      --  and Comp accordingly.
+
+      function Is_Entity_Length (N : Node_Id) return Boolean;
+      --  Tests if N is a length attribute applied to a simple entity. If so,
+      --  returns True, and sets Ent to the entity, and Index to the integer
+      --  literal provided as an attribute expression, or to Empty if none.
+      --  Also returns True if the expression is a generated type conversion
+      --  whose expression is of the desired form. This latter case arises
+      --  when Apply_Universal_Integer_Attribute_Check installs a conversion
+      --  to check for being in range, which is not needed in this context.
+      --  Returns False if neither condition holds.
+
+      function Prepare_64 (N : Node_Id) return Node_Id;
+      --  Given a discrete expression, returns a Long_Long_Integer typed
+      --  expression representing the underlying value of the expression.
+      --  This is done with an unchecked conversion to the result type. We
+      --  use unchecked conversion to handle the enumeration type case.
+
+      ----------------------
+      -- Is_Entity_Length --
+      ----------------------
+
+      function Is_Entity_Length (N : Node_Id) return Boolean is
+      begin
+         if Nkind (N) = N_Attribute_Reference
+           and then Attribute_Name (N) = Name_Length
+           and then Is_Entity_Name (Prefix (N))
+         then
+            Ent := Entity (Prefix (N));
+
+            if Present (Expressions (N)) then
+               Index := First (Expressions (N));
+            else
+               Index := Empty;
+            end if;
+
+            return True;
+
+         elsif Nkind (N) = N_Type_Conversion
+           and then not Comes_From_Source (N)
+         then
+            return Is_Entity_Length (Expression (N));
+
+         else
+            return False;
+         end if;
+      end Is_Entity_Length;
+
+      --------------------
+      -- Is_Optimizable --
+      --------------------
+
+      function Is_Optimizable (N : Node_Id) return Boolean is
+         Val  : Uint;
+         OK   : Boolean;
+         Lo   : Uint;
+         Hi   : Uint;
+         Indx : Node_Id;
+
+      begin
+         if Compile_Time_Known_Value (N) then
+            Val := Expr_Value (N);
+
+            if Val = Uint_0 then
+               Is_Zero := True;
+               Comp    := Empty;
+               return True;
+
+            elsif Val = Uint_1 then
+               Is_Zero := False;
+               Comp    := Empty;
+               return True;
+            end if;
+         end if;
+
+         --  Here we have to make sure of being within 32-bits
+
+         Determine_Range (N, OK, Lo, Hi, Assume_Valid => True);
+
+         if not OK
+           or else Lo < UI_From_Int (Int'First)
+           or else Hi > UI_From_Int (Int'Last)
+         then
+            return False;
+         end if;
+
+         --  Comparison value was within 32-bits, so now we must check the
+         --  index value to make sure it is also within 32-bits.
+
+         Indx := First_Index (Etype (Ent));
+
+         if Present (Index) then
+            for J in 2 .. UI_To_Int (Intval (Index)) loop
+               Next_Index (Indx);
+            end loop;
+         end if;
+
+         Ityp := Etype (Indx);
+
+         if Esize (Ityp) > 32 then
+            return False;
+         end if;
+
+         Is_Zero := False;
+         Comp := N;
+         return True;
+      end Is_Optimizable;
+
+      ----------------
+      -- Prepare_64 --
+      ----------------
+
+      function Prepare_64 (N : Node_Id) return Node_Id is
+      begin
+         return Unchecked_Convert_To (Standard_Long_Long_Integer, N);
+      end Prepare_64;
+
+   --  Start of processing for Optimize_Length_Comparison
+
+   begin
+      --  Nothing to do if not a comparison
+
+      if Op not in N_Op_Compare then
+         return;
+      end if;
+
+      --  Nothing to do if special -gnatd.P debug flag set
+
+      if Debug_Flag_Dot_PP then
+         return;
+      end if;
+
+      --  Ent'Length op 0/1
+
+      if Is_Entity_Length (Left_Opnd (N))
+        and then Is_Optimizable (Right_Opnd (N))
+      then
+         null;
+
+      --  0/1 op Ent'Length
+
+      elsif Is_Entity_Length (Right_Opnd (N))
+        and then Is_Optimizable (Left_Opnd (N))
+      then
+         --  Flip comparison to opposite sense
+
+         case Op is
+            when N_Op_Lt => Op := N_Op_Gt;
+            when N_Op_Le => Op := N_Op_Ge;
+            when N_Op_Gt => Op := N_Op_Lt;
+            when N_Op_Ge => Op := N_Op_Le;
+            when others  => null;
+         end case;
+
+      --  Else optimization not possible
+
+      else
+         return;
+      end if;
+
+      --  Fall through if we will do the optimization
+
+      --  Cases to handle:
+
+      --    X'Length = 0  => X'First > X'Last
+      --    X'Length = 1  => X'First = X'Last
+      --    X'Length = n  => X'First + (n - 1) = X'Last
+
+      --    X'Length /= 0 => X'First <= X'Last
+      --    X'Length /= 1 => X'First /= X'Last
+      --    X'Length /= n => X'First + (n - 1) /= X'Last
+
+      --    X'Length >= 0 => always true, warn
+      --    X'Length >= 1 => X'First <= X'Last
+      --    X'Length >= n => X'First + (n - 1) <= X'Last
+
+      --    X'Length > 0  => X'First <= X'Last
+      --    X'Length > 1  => X'First < X'Last
+      --    X'Length > n  => X'First + (n - 1) < X'Last
+
+      --    X'Length <= 0 => X'First > X'Last (warn, could be =)
+      --    X'Length <= 1 => X'First >= X'Last
+      --    X'Length <= n => X'First + (n - 1) >= X'Last
+
+      --    X'Length < 0  => always false (warn)
+      --    X'Length < 1  => X'First > X'Last
+      --    X'Length < n  => X'First + (n - 1) > X'Last
+
+      --  Note: for the cases of n (not constant 0,1), we require that the
+      --  corresponding index type be integer or shorter (i.e. not 64-bit),
+      --  and the same for the comparison value. Then we do the comparison
+      --  using 64-bit arithmetic (actually long long integer), so that we
+      --  cannot have overflow intefering with the result.
+
+      --  First deal with warning cases
+
+      if Is_Zero then
+         case Op is
+
+            --  X'Length >= 0
+
+            when N_Op_Ge =>
+               Rewrite (N,
+                 Convert_To (Typ, New_Occurrence_Of (Standard_True, Loc)));
+               Analyze_And_Resolve (N, Typ);
+               Warn_On_Known_Condition (N);
+               return;
+
+            --  X'Length < 0
+
+            when N_Op_Lt =>
+               Rewrite (N,
+                 Convert_To (Typ, New_Occurrence_Of (Standard_False, Loc)));
+               Analyze_And_Resolve (N, Typ);
+               Warn_On_Known_Condition (N);
+               return;
+
+            when N_Op_Le =>
+               if Constant_Condition_Warnings
+                 and then Comes_From_Source (Original_Node (N))
+               then
+                  Error_Msg_N ("could replace by ""'=""?", N);
+               end if;
+
+               Op := N_Op_Eq;
+
+            when others =>
+               null;
+         end case;
+      end if;
+
+      --  Build the First reference we will use
+
+      Left :=
+        Make_Attribute_Reference (Loc,
+          Prefix         => New_Occurrence_Of (Ent, Loc),
+          Attribute_Name => Name_First);
+
+      if Present (Index) then
+         Set_Expressions (Left, New_List (New_Copy (Index)));
+      end if;
+
+      --  If general value case, then do the addition of (n - 1), and
+      --  also add the needed conversions to type Long_Long_Integer.
+
+      if Present (Comp) then
+         Left :=
+           Make_Op_Add (Loc,
+             Left_Opnd  => Prepare_64 (Left),
+             Right_Opnd =>
+               Make_Op_Subtract (Loc,
+                 Left_Opnd  => Prepare_64 (Comp),
+                 Right_Opnd => Make_Integer_Literal (Loc, 1)));
+      end if;
+
+      --  Build the Last reference we will use
+
+      Right :=
+        Make_Attribute_Reference (Loc,
+          Prefix         => New_Occurrence_Of (Ent, Loc),
+          Attribute_Name => Name_Last);
+
+      if Present (Index) then
+         Set_Expressions (Right, New_List (New_Copy (Index)));
+      end if;
+
+      --  If general operand, convert Last reference to Long_Long_Integer
+
+      if Present (Comp) then
+         Right := Prepare_64 (Right);
+      end if;
+
+      --  Check for cases to optimize
+
+      --  X'Length = 0  => X'First > X'Last
+      --  X'Length < 1  => X'First > X'Last
+      --  X'Length < n  => X'First + (n - 1) > X'Last
+
+      if (Is_Zero and then Op = N_Op_Eq)
+        or else (not Is_Zero and then Op = N_Op_Lt)
+      then
+         Result :=
+           Make_Op_Gt (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  X'Length = 1  => X'First = X'Last
+      --  X'Length = n  => X'First + (n - 1) = X'Last
+
+      elsif not Is_Zero and then Op = N_Op_Eq then
+         Result :=
+           Make_Op_Eq (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  X'Length /= 0 => X'First <= X'Last
+      --  X'Length > 0  => X'First <= X'Last
+
+      elsif Is_Zero and (Op = N_Op_Ne or else Op = N_Op_Gt) then
+         Result :=
+           Make_Op_Le (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  X'Length /= 1 => X'First /= X'Last
+      --  X'Length /= n => X'First + (n - 1) /= X'Last
+
+      elsif not Is_Zero and then Op = N_Op_Ne then
+         Result :=
+           Make_Op_Ne (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  X'Length >= 1 => X'First <= X'Last
+      --  X'Length >= n => X'First + (n - 1) <= X'Last
+
+      elsif not Is_Zero and then Op = N_Op_Ge then
+         Result :=
+           Make_Op_Le (Loc,
+             Left_Opnd  => Left,
+                       Right_Opnd => Right);
+
+      --  X'Length > 1  => X'First < X'Last
+      --  X'Length > n  => X'First + (n = 1) < X'Last
+
+      elsif not Is_Zero and then Op = N_Op_Gt then
+         Result :=
+           Make_Op_Lt (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  X'Length <= 1 => X'First >= X'Last
+      --  X'Length <= n => X'First + (n - 1) >= X'Last
+
+      elsif not Is_Zero and then Op = N_Op_Le then
+         Result :=
+           Make_Op_Ge (Loc,
+             Left_Opnd  => Left,
+             Right_Opnd => Right);
+
+      --  Should not happen at this stage
+
+      else
+         raise Program_Error;
+      end if;
+
+      --  Rewrite and finish up
+
+      Rewrite (N, Result);
+      Analyze_And_Resolve (N, Typ);
+      return;
+   end Optimize_Length_Comparison;
+
    ------------------------
    -- Rewrite_Comparison --
    ------------------------
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index ae92522f874..15db8b9668b 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -11516,7 +11516,7 @@ package body Exp_Ch9 is
       end if;
 
       --  If the type of the dispatching object is an access type then return
-      --  an explicit dereference
+      --  an explicit dereference.
 
       if Is_Access_Type (Etype (Object)) then
          Object := Make_Explicit_Dereference (Sloc (N), Object);
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 6b5318f3385..f1320ec554e 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -89,13 +89,23 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
 
    procedure Process_Restrictions_Or_Restriction_Warnings;
    --  Common processing for Restrictions and Restriction_Warnings pragmas.
-   --  This routine processes the cases of No_Obsolescent_Features and SPARK,
-   --  which are the only restriction that have syntactic effects. In the case
-   --  of SPARK, it controls whether the scanner generates a token
-   --  Tok_SPARK_Hide for HIDE directives formatted as Ada comments. No general
-   --  error checking is done, since this will be done in Sem_Prag. The other
-   --  case processed is pragma Restrictions No_Dependence, since otherwise
-   --  this is done too late.
+   --  For the most part, restrictions need not be processed at parse time,
+   --  since they only affect semantic processing. This routine handles the
+   --  exceptions as follows
+   --
+   --    No_Obsolescent_Features must be processed at parse time, since there
+   --    are some obsolescent features (e.g. character replacements) which are
+   --    handled at parse time.
+   --
+   --    SPARK must be processed at parse time, since this restriction controls
+   --    whether the scanner recognizes a spark HIDE directive formatted as an
+   --    Ada comment (and generates a Tok_SPARK_Hide token for the directive).
+   --
+   --    No_Dependence must be processed at parse time, since otherwise it gets
+   --    handled too late.
+   --
+   --  Note that we don't need to do full error checking for badly formed cases
+   --  of restrictions, since these will be caught during semantic analysis.
 
    ----------
    -- Arg1 --
@@ -232,10 +242,12 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
                   Set_Restriction (No_Obsolescent_Features, Pragma_Node);
                   Restriction_Warnings (No_Obsolescent_Features) :=
                     Prag_Id = Pragma_Restriction_Warnings;
+
                when SPARK =>
                   Set_Restriction (SPARK, Pragma_Node);
                   Restriction_Warnings (SPARK) :=
                     Prag_Id = Pragma_Restriction_Warnings;
+
                when others =>
                   null;
             end case;
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index 5472d056ee1..92709c93526 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -178,9 +178,9 @@ package Restrict is
    -- SPARK Restriction Control --
    -------------------------------
 
-   --  SPARK HIDE directives allow turning off SPARK restriction for a
-   --  specified region of code, and the following tables are the data
-   --  structures used to keep track of these regions.
+   --  SPARK HIDE directives allow the effect of the SPARK restriction to be
+   --  turned off for a specified region of code, and the following tables are
+   --  the data structures used to keep track of these regions.
 
    --  The table contains pairs of source locations, the first being the start
    --  location for hidden region, and the second being the end location.
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 73b8f393dca..f0bc9de8b27 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -1764,8 +1764,8 @@ package body Scng is
                   return;
                end if;
 
-               --  Generate a token Tok_SPARK_Hide for a SPARK HIDE directive
-               --  only if the SPARK restriction is set for this unit.
+               --  If the SPARK restriction is set for this unit, then generate
+               --  a token Tok_SPARK_Hide for a SPARK HIDE directive.
 
                if Restriction_Check_Required (SPARK)
                  and then Source (Start_Of_Comment) = '#'
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index a9a9100b504..8d8980e194b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2335,6 +2335,7 @@ package body Sem_Util is
 
    procedure Mark_Non_ALFA_Subprogram_Unconditional is
       Cur_Subp : constant Entity_Id := Current_Subprogram;
+
    begin
       if Present (Cur_Subp)
         and then (Is_Subprogram (Cur_Subp)
@@ -2344,6 +2345,9 @@ package body Sem_Util is
          --  then mark the subprogram as not in ALFA. Otherwise, mark the
          --  subprogram body as not in ALFA.
 
+         --  This comment just says what is done, but not why ??? and it
+         --  just repeats what is in the spec ???
+
          if In_Pre_Post_Expression then
             Set_Is_In_ALFA (Cur_Subp, False);
          else
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 938b03100cd..371afbb9103 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -279,10 +279,14 @@ package Sem_Util is
 
    procedure Mark_Non_ALFA_Subprogram;
    --  If Current_Subprogram is not Empty, mark either its specification or its
-   --  body as not being in ALFA. If called during the analysis of a
-   --  precondition or postcondition, as indicated by the flag
+   --  body as not being in ALFA. If this procedure is called during the
+   --  analysis of a precondition or postcondition, as indicated by the flag
    --  In_Pre_Post_Expression, mark the specification as not being in ALFA.
    --  Otherwise, mark the body as not being in ALFA.
+   --
+   --  I would really like to see more comments on this peculiar processing
+   --  for precondition/postcondition, the comment above says what is done
+   --  but not why???
 
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 88bcafbd125..48b138e4c7c 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1116,7 +1116,7 @@ package Sinfo is
    --    this is required, see Exp_Ch11.Remove_Handler_Entries.
 
    --  Has_Dynamic_Length_Check (Flag10-Sem)
-   --    This flag is present on all expression nodes. It is set to indicate
+   --    This flag is present in all expression nodes. It is set to indicate
    --    that one of the routines in unit Checks has generated a length check
    --    action which has been inserted at the flagged node. This is used to
    --    avoid the generation of duplicate checks.
@@ -1126,7 +1126,8 @@ package Sinfo is
    --    expression nodes. It is set to indicate that one of the routines in
    --    unit Checks has generated a range check action which has been inserted
    --    at the flagged node. This is used to avoid the generation of duplicate
-   --    checks.
+   --    checks. Why does this occur on N_Subtype_Declaration nodes, what does
+   --    it mean in that context???
 
    --  Has_Local_Raise (Flag8-Sem)
    --    Present in exception handler nodes. Set if the handler can be entered