s-osinte-lynxos-3.ads, [...]: Add missing pragma Convention C for subprogram pointers.

2007-12-06  Robert Dewar  <dewar@adacore.com>

	* s-osinte-lynxos-3.ads, s-osinte-hpux.ads, s-osinte-solaris-posix.ads, 
	s-osinte-freebsd.ads, s-osinte-lynxos.ads, s-osinte-tru64.ads, 
	s-osinte-mingw.ads, s-osinte-aix.ads, s-osinte-hpux-dce.ads, 
	s-osinte-irix.ads, s-osinte-solaris.ads, s-intman-vms.adb,
	s-osinte-vms.ads, s-osinte-vxworks6.ads, s-osinte-vxworks.ads,
	s-auxdec.ads, s-auxdec-vms_64.ads, s-osinte-darwin.ads, 
	s-taprop-vms.adb, s-interr-sigaction.adb, s-osinte-linux-hppa.ads, 
	i-vxwork-x86.ads, s-tpopde-vms.ads: Add missing pragma Convention C
	for subprogram pointers.

	* g-ctrl_c.adb: New file.

	* g-ctrl_c.ads (Install_Handler): New body.

	* freeze.adb (Freeze_Subprogram): Use new flag Has_Pragma_Inline_Always
	instead of obsolete function Is_Always_Inlined.
	(Freeze_Entity): check for tagged type in imported C subprogram
	(Freeze_Entity): check for 8-bit boolean in imported C subprogram
	(Freeze_Entity): check for convention Ada subprogram pointer in
	imported C subprogram.
	(Freeze_Fixed_Point_Type): In the case of a base type where the low
	bound would be chopped off and go from negative to zero, force
	Loval_Excl_EP to be the same as Loval_Incl_EP (the included lower
	bound) so that the size computation for the base type will take
	negative values into account.

From-SVN: r130813

gcc/ada/freeze.adb

@@ -243,11 +243,16 @@ package body Freeze is
       O_Formal   : Entity_Id;
       Param_Spec : Node_Id;
 
+      Pref : Node_Id := Empty;
+      --  If the renamed entity is a primitive operation given in prefix form,
+      --  the prefix is the target object and it has to be added as the first
+      --  actual in the generated call.
+
    begin
-      --  Determine the entity being renamed, which is the target of the
-      --  call statement. If the name is an explicit dereference, this is
-      --  a renaming of a subprogram type rather than a subprogram. The
-      --  name itself is fully analyzed.
+      --  Determine the entity being renamed, which is the target of the call
+      --  statement. If the name is an explicit dereference, this is a renaming
+      --  of a subprogram type rather than a subprogram. The name itself is
+      --  fully analyzed.
 
       if Nkind (Nam) = N_Selected_Component then
          Old_S := Entity (Selector_Name (Nam));
@@ -271,8 +276,8 @@ package body Freeze is
 
       if Is_Entity_Name (Nam) then
 
-         --  If the renamed entity is a predefined operator, retain full
-         --  name to ensure its visibility.
+         --  If the renamed entity is a predefined operator, retain full name
+         --  to ensure its visibility.
 
          if Ekind (Old_S) = E_Operator
            and then Nkind (Nam) = N_Expanded_Name
@@ -283,7 +288,22 @@ package body Freeze is
          end if;
 
       else
-         Call_Name := New_Copy (Name (N));
+         if Nkind (Nam) = N_Selected_Component
+           and then Present (First_Formal (Old_S))
+           and then
+             (Is_Controlling_Formal (First_Formal (Old_S))
+                or else Is_Class_Wide_Type (Etype (First_Formal (Old_S))))
+         then
+
+            --  Retrieve the target object, to be added as a first actual
+            --  in the call.
+
+            Call_Name := New_Occurrence_Of (Old_S, Loc);
+            Pref := Prefix (Nam);
+
+         else
+            Call_Name := New_Copy (Name (N));
+         end if;
 
          --  The original name may have been overloaded, but
          --  is fully resolved now.
@@ -291,9 +311,9 @@ package body Freeze is
          Set_Is_Overloaded (Call_Name, False);
       end if;
 
-      --  For simple renamings, subsequent calls can be expanded directly
-      --  as called to the renamed entity. The body must be generated in
-      --  any case for calls they may appear elsewhere.
+      --  For simple renamings, subsequent calls can be expanded directly as
+      --  called to the renamed entity. The body must be generated in any case
+      --  for calls they may appear elsewhere.
 
       if (Ekind (Old_S) = E_Function
            or else Ekind (Old_S) = E_Procedure)
@@ -309,23 +329,55 @@ package body Freeze is
 
       Formal := First_Formal (Defining_Entity (Decl));
 
-      if Present (Formal) then
+      if Present (Pref) then
+         declare
+            Pref_Type : constant Entity_Id := Etype (Pref);
+            Form_Type : constant Entity_Id := Etype (First_Formal (Old_S));
+
+         begin
+
+            --  The controlling formal may be an access parameter, or the
+            --  actual may be an access value, so ajust accordingly.
+
+            if Is_Access_Type (Pref_Type)
+              and then not Is_Access_Type (Form_Type)
+            then
+               Actuals := New_List
+                 (Make_Explicit_Dereference (Loc, Relocate_Node (Pref)));
+
+            elsif Is_Access_Type (Form_Type)
+              and then not Is_Access_Type (Pref)
+            then
+               Actuals := New_List
+                 (Make_Attribute_Reference (Loc,
+                   Attribute_Name => Name_Access,
+                   Prefix => Relocate_Node (Pref)));
+            else
+               Actuals := New_List (Pref);
+            end if;
+         end;
+
+      elsif Present (Formal) then
          Actuals := New_List;
 
+      else
+         Actuals := No_List;
+      end if;
+
+      if Present (Formal) then
          while Present (Formal) loop
             Append (New_Reference_To (Formal, Loc), Actuals);
             Next_Formal (Formal);
          end loop;
       end if;
 
-      --  If the renamed entity is an entry, inherit its profile. For
-      --  other renamings as bodies, both profiles must be subtype
-      --  conformant, so it is not necessary to replace the profile given
-      --  in the declaration. However, default values that are aggregates
-      --  are rewritten when partially analyzed, so we recover the original
-      --  aggregate to insure that subsequent conformity checking works.
-      --  Similarly, if the default expression was constant-folded, recover
-      --  the original expression.
+      --  If the renamed entity is an entry, inherit its profile. For other
+      --  renamings as bodies, both profiles must be subtype conformant, so it
+      --  is not necessary to replace the profile given in the declaration.
+      --  However, default values that are aggregates are rewritten when
+      --  partially analyzed, so we recover the original aggregate to insure
+      --  that subsequent conformity checking works. Similarly, if the default
+      --  expression was constant-folded, recover the original expression.
 
       Formal := First_Formal (Defining_Entity (Decl));
 
@@ -421,8 +473,8 @@ package body Freeze is
       end if;
 
       --  Link the body to the entity whose declaration it completes. If
-      --  the body is analyzed when the renamed entity is frozen, it may be
-      --  necessary to restore the proper scope (see package Exp_Ch13).
+      --  the body is analyzed when the renamed entity is frozen, it may
+      --  be necessary to restore the proper scope (see package Exp_Ch13).
 
       if Nkind (N) =  N_Subprogram_Renaming_Declaration
         and then Present (Corresponding_Spec (N))
@@ -449,18 +501,16 @@ package body Freeze is
       if Present (Addr) then
          Expr := Expression (Addr);
 
-         --  If we have no initialization of any kind, then we don't
-         --  need to place any restrictions on the address clause, because
-         --  the object will be elaborated after the address clause is
-         --  evaluated. This happens if the declaration has no initial
-         --  expression, or the type has no implicit initialization, or
-         --  the object is imported.
+         --  If we have no initialization of any kind, then we don't need to
+         --  place any restrictions on the address clause, because the object
+         --  will be elaborated after the address clause is evaluated. This
+         --  happens if the declaration has no initial expression, or the type
+         --  has no implicit initialization, or the object is imported.
 
-         --  The same holds for all initialized scalar types and all
-         --  access types. Packed bit arrays of size up to 64 are
-         --  represented using a modular type with an initialization
-         --  (to zero) and can be processed like other initialized
-         --  scalar types.
+         --  The same holds for all initialized scalar types and all access
+         --  types. Packed bit arrays of size up to 64 are represented using a
+         --  modular type with an initialization (to zero) and can be processed
+         --  like other initialized scalar types.
 
          --  If the type is controlled, code to attach the object to a
          --  finalization chain is generated at the point of declaration,
@@ -487,9 +537,9 @@ package body Freeze is
          then
             null;
 
-         --  Otherwise, we require the address clause to be constant
-         --  because the call to the initialization procedure (or the
-         --  attach code) has to happen at the point of the declaration.
+         --  Otherwise, we require the address clause to be constant because
+         --  the call to the initialization procedure (or the attach code) has
+         --  to happen at the point of the declaration.
 
          else
             Check_Constant_Address_Clause (Expr, E);
@@ -587,8 +637,8 @@ package body Freeze is
             elsif not Is_Constrained (T) then
                return False;
 
-            --  Don't do any recursion on type with error posted, since
-            --  we may have a malformed type that leads us into a loop
+            --  Don't do any recursion on type with error posted, since we may
+            --  have a malformed type that leads us into a loop.
 
             elsif Error_Posted (T) then
                return False;
@@ -597,8 +647,8 @@ package body Freeze is
                return False;
             end if;
 
-            --  Check for all indexes static, and also compute possible
-            --  size (in case it is less than 32 and may be packable).
+            --  Check for all indexes static, and also compute possible size
+            --  (in case it is less than 32 and may be packable).
 
             declare
                Esiz : Uint := Component_Size (T);
@@ -648,8 +698,8 @@ package body Freeze is
            and then not Is_Generic_Type (T)
            and then Present (Underlying_Type (T))
          then
-            --  Don't do any recursion on type with error posted, since
-            --  we may have a malformed type that leads us into a loop
+            --  Don't do any recursion on type with error posted, since we may
+            --  have a malformed type that leads us into a loop.
 
             if Error_Posted (T) then
                return False;
@@ -672,8 +722,8 @@ package body Freeze is
             then
                return False;
 
-            --  Don't do any recursion on type with error posted, since
-            --  we may have a malformed type that leads us into a loop
+            --  Don't do any recursion on type with error posted, since we may
+            --  have a malformed type that leads us into a loop.
 
             elsif Error_Posted (T) then
                return False;
@@ -682,16 +732,15 @@ package body Freeze is
             --  Now look at the components of the record
 
             declare
-               --  The following two variables are used to keep track of
-               --  the size of packed records if we can tell the size of
-               --  the packed record in the front end. Packed_Size_Known
-               --  is True if so far we can figure out the size. It is
-               --  initialized to True for a packed record, unless the
-               --  record has discriminants. The reason we eliminate the
-               --  discriminated case is that we don't know the way the
-               --  back end lays out discriminated packed records. If
-               --  Packed_Size_Known is True, then Packed_Size is the
-               --  size in bits so far.
+               --  The following two variables are used to keep track of the
+               --  size of packed records if we can tell the size of the packed
+               --  record in the front end. Packed_Size_Known is True if so far
+               --  we can figure out the size. It is initialized to True for a
+               --  packed record, unless the record has discriminants. The
+               --  reason we eliminate the discriminated case is that we don't
+               --  know the way the back end lays out discriminated packed
+               --  records. If Packed_Size_Known is True, then Packed_Size is
+               --  the size in bits so far.
 
                Packed_Size_Known : Boolean :=
                                      Is_Packed (T)
@@ -797,8 +846,8 @@ package body Freeze is
                      end;
                   end if;
 
-                  --  Clearly size of record is not known if the size of
-                  --  one of the components is not known.
+                  --  Clearly size of record is not known if the size of one of
+                  --  the components is not known.
 
                   if not Size_Known (Ctyp) then
                      return False;
@@ -1063,12 +1112,11 @@ package body Freeze is
 
          Set_Expression (Parent (E), New_Occurrence_Of (Temp, Loc));
 
-         --  To prevent the temporary from being constant-folded (which
-         --  would lead to the same piecemeal assignment on the original
-         --  target) indicate to the back-end that the temporary  is a
-         --  variable with real storage. See description of this flag
-         --  in Einfo, and the notes on N_Assignment_Statement and
-         --  N_Object_Declaration in Sinfo.
+         --  To prevent the temporary from being constant-folded (which would
+         --  lead to the same piecemeal assignment on the original target)
+         --  indicate to the back-end that the temporary is a variable with
+         --  real storage. See description of this flag in Einfo, and the notes
+         --  on N_Assignment_Statement and N_Object_Declaration in Sinfo.
 
          Set_Is_True_Constant (Temp, False);
       end if;
@@ -1091,10 +1139,10 @@ package body Freeze is
       Decl  : Node_Id;
 
       procedure Freeze_All_Ent (From : Entity_Id; After : in out Node_Id);
-      --  This is the internal recursive routine that does freezing of
-      --  entities (but NOT the analysis of default expressions, which
-      --  should not be recursive, we don't want to analyze those till
-      --  we are sure that ALL the types are frozen).
+      --  This is the internal recursive routine that does freezing of entities
+      --  (but NOT the analysis of default expressions, which should not be
+      --  recursive, we don't want to analyze those till we are sure that ALL
+      --  the types are frozen).
 
       --------------------
       -- Freeze_All_Ent --
@@ -1109,8 +1157,8 @@ package body Freeze is
          Lastn : Node_Id;
 
          procedure Process_Flist;
-         --  If freeze nodes are present, insert and analyze, and reset
-         --  cursor for next insertion.
+         --  If freeze nodes are present, insert and analyze, and reset cursor
+         --  for next insertion.
 
          -------------------
          -- Process_Flist --
@@ -1137,9 +1185,9 @@ package body Freeze is
          while Present (E) loop
 
             --  If the entity is an inner package which is not a package
-            --  renaming, then its entities must be frozen at this point.
-            --  Note that such entities do NOT get frozen at the end of
-            --  the nested package itself (only library packages freeze).
+            --  renaming, then its entities must be frozen at this point. Note
+            --  that such entities do NOT get frozen at the end of the nested
+            --  package itself (only library packages freeze).
 
             --  Same is true for task declarations, where anonymous records
             --  created for entry parameters must be frozen.
@@ -1168,9 +1216,9 @@ package body Freeze is
                End_Scope;
 
             --  For a derived tagged type, we must ensure that all the
-            --  primitive operations of the parent have been frozen, so
-            --  that their addresses will be in the parent's dispatch table
-            --  at the point it is inherited.
+            --  primitive operations of the parent have been frozen, so that
+            --  their addresses will be in the parent's dispatch table at the
+            --  point it is inherited.
 
             elsif Ekind (E) = E_Record_Type
               and then Is_Tagged_Type (E)
@@ -1207,13 +1255,12 @@ package body Freeze is
                Process_Flist;
             end if;
 
-            --  If an incomplete type is still not frozen, this may be
-            --  a premature freezing because of a body declaration that
-            --  follows. Indicate where the freezing took place.
+            --  If an incomplete type is still not frozen, this may be a
+            --  premature freezing because of a body declaration that follows.
+            --  Indicate where the freezing took place.
 
-            --  If the freezing is caused by the end of the current
-            --  declarative part, it is a Taft Amendment type, and there
-            --  is no error.
+            --  If the freezing is caused by the end of the current declarative
+            --  part, it is a Taft Amendment type, and there is no error.
 
             if not Is_Frozen (E)
               and then Ekind (E) = E_Incomplete_Type
@@ -1416,7 +1463,7 @@ package body Freeze is
          begin
             case Nkind (N) is
                when N_Attribute_Reference =>
-                  if  (Attribute_Name (N) = Name_Access
+                  if (Attribute_Name (N) = Name_Access
                         or else
                       Attribute_Name (N) = Name_Unchecked_Access)
                     and then Is_Entity_Name (Prefix (N))
@@ -1831,16 +1878,16 @@ package body Freeze is
                   end if;
                end;
 
-            --  If the component is an access type with an allocator as
-            --  default value, the designated type will be frozen by the
-            --  corresponding expression in init_proc. In order to place the
-            --  freeze node for the designated type before that for the
-            --  current record type, freeze it now.
+            --  If the component is an access type with an allocator as default
+            --  value, the designated type will be frozen by the corresponding
+            --  expression in init_proc. In order to place the freeze node for
+            --  the designated type before that for the current record type,
+            --  freeze it now.
 
             --  Same process if the component is an array of access types,
             --  initialized with an aggregate. If the designated type is
-            --  private, it cannot contain allocators, and it is premature to
-            --  freeze the type, so we check for this as well.
+            --  private, it cannot contain allocators, and it is premature
+            --  to freeze the type, so we check for this as well.
 
             elsif Is_Access_Type (Etype (Comp))
               and then Present (Parent (Comp))
@@ -1916,8 +1963,8 @@ package body Freeze is
                Error_Msg_N
                  ("\?since no component clauses were specified", ADC);
 
-            --  Here is where we do Ada 2005 processing for bit order (the
-            --  Ada 95 case was already taken care of above).
+            --  Here is where we do Ada 2005 processing for bit order (the Ada
+            --  95 case was already taken care of above).
 
             elsif Ada_Version >= Ada_05 then
                Adjust_Record_For_Reverse_Bit_Order (Rec);
@@ -1933,9 +1980,9 @@ package body Freeze is
            and then Is_Packed (Rec)
            and then not Unplaced_Component
          then
-            --  Reset packed status. Probably not necessary, but we do it
-            --  so that there is no chance of the back end doing something
-            --  strange with this redundant indication of packing.
+            --  Reset packed status. Probably not necessary, but we do it so
+            --  that there is no chance of the back end doing something strange
+            --  with this redundant indication of packing.
 
             Set_Is_Packed (Rec, False);
 
@@ -2125,12 +2172,12 @@ package body Freeze is
 
       --  Similarly, an inlined instance body may make reference to global
       --  entities, but these references cannot be the proper freezing point
-      --  for them, and in the absence of inlining freezing will take place
-      --  in their own scope. Normally instance bodies are analyzed after
-      --  the enclosing compilation, and everything has been frozen at the
-      --  proper place, but with front-end inlining an instance body is
-      --  compiled before the end of the enclosing scope, and as a result
-      --  out-of-order freezing must be prevented.
+      --  for them, and in the absence of inlining freezing will take place in
+      --  their own scope. Normally instance bodies are analyzed after the
+      --  enclosing compilation, and everything has been frozen at the proper
+      --  place, but with front-end inlining an instance body is compiled
+      --  before the end of the enclosing scope, and as a result out-of-order
+      --  freezing must be prevented.
 
       elsif Front_End_Inlining
         and then In_Instance_Body
@@ -2220,26 +2267,9 @@ package body Freeze is
             if not Is_Internal (E) then
                declare
                   F_Type    : Entity_Id;
+                  R_Type    : Entity_Id;
                   Warn_Node : Node_Id;
 
-                  function Is_Fat_C_Ptr_Type (T : Entity_Id) return Boolean;
-                  --  Determines if given type entity is a fat pointer type
-                  --  used as an argument type or return type to a subprogram
-                  --  with C or C++ convention set.
-
-                  --------------------------
-                  -- Is_Fat_C_Access_Type --
-                  --------------------------
-
-                  function Is_Fat_C_Ptr_Type (T : Entity_Id) return Boolean is
-                  begin
-                     return (Convention (E) = Convention_C
-                               or else
-                             Convention (E) = Convention_CPP)
-                       and then Is_Access_Type (T)
-                       and then Esize (T) > Ttypes.System_Address_Size;
-                  end Is_Fat_C_Ptr_Type;
-
                begin
                   --  Loop through formals
 
@@ -2277,22 +2307,72 @@ package body Freeze is
                         end if;
                      end if;
 
-                     --  Check bad use of fat C pointer
+                     --  Check suspicious parameter for C function. These tests
+                     --  apply only to exported/imported suboprograms.
 
-                     if Warn_On_Export_Import and then
-                       Is_Fat_C_Ptr_Type (F_Type)
+                     if Warn_On_Export_Import
+                       and then (Convention (E) = Convention_C
+                                   or else
+                                 Convention (E) = Convention_CPP)
+                       and then not Warnings_Off (E)
+                       and then not Warnings_Off (F_Type)
+                       and then not Warnings_Off (Formal)
+                       and then (Is_Imported (E) or else Is_Exported (E))
                      then
                         Error_Msg_Qual_Level := 1;
-                        Error_Msg_N
-                           ("?type of & does not correspond to C pointer",
-                            Formal);
+
+                        --  Check suspicious use of fat C pointer
+
+                        if Is_Access_Type (F_Type)
+                          and then Esize (F_Type) > Ttypes.System_Address_Size
+                        then
+                           Error_Msg_N
+                             ("?type of & does not correspond "
+                              & "to C pointer!", Formal);
+
+                        --  Check suspicious return of boolean
+
+                        elsif Root_Type (F_Type) = Standard_Boolean
+                          and then Convention (F_Type) = Convention_Ada
+                        then
+                           Error_Msg_N
+                             ("?& is an 8-bit Ada Boolean, "
+                              & "use char in C!", Formal);
+
+                        --  Check suspicious tagged type
+
+                        elsif (Is_Tagged_Type (F_Type)
+                                or else (Is_Access_Type (F_Type)
+                                           and then
+                                             Is_Tagged_Type
+                                               (Designated_Type (F_Type))))
+                          and then Convention (E) = Convention_C
+                        then
+                           Error_Msg_N
+                             ("?& is a tagged type which does not "
+                              & "correspond to any C type!", Formal);
+
+                        --  Check wrong convention subprogram pointer
+
+                        elsif Ekind (F_Type) = E_Access_Subprogram_Type
+                          and then not Has_Foreign_Convention (F_Type)
+                        then
+                           Error_Msg_N
+                             ("?subprogram pointer & should "
+                              & "have foreign convention!", Formal);
+                           Error_Msg_Sloc := Sloc (F_Type);
+                           Error_Msg_NE
+                             ("\?add Convention pragma to declaration of &#",
+                              Formal, F_Type);
+                        end if;
+
                         Error_Msg_Qual_Level := 0;
                      end if;
 
                      --  Check for unconstrained array in exported foreign
                      --  convention case.
 
-                     if Convention (E) in Foreign_Convention
+                     if Has_Foreign_Convention (E)
                        and then not Is_Imported (E)
                        and then Is_Array_Type (F_Type)
                        and then not Is_Constrained (F_Type)
@@ -2365,22 +2445,75 @@ package body Freeze is
                      Next_Formal (Formal);
                   end loop;
 
-                  --  Check return type
+                  --  Case of function
 
                   if Ekind (E) = E_Function then
-                     Freeze_And_Append (Etype (E), Loc, Result);
+
+                     --  Freeze return type
+
+                     R_Type := Etype (E);
+                     Freeze_And_Append (R_Type, Loc, Result);
+
+                     --  Check suspicious return type for C function
 
                      if Warn_On_Export_Import
-                       and then Is_Fat_C_Ptr_Type (Etype (E))
+                       and then (Convention (E) = Convention_C
+                                   or else
+                                 Convention (E) = Convention_CPP)
+                       and then not Warnings_Off (E)
+                       and then not Warnings_Off (R_Type)
+                       and then (Is_Imported (E) or else Is_Exported (E))
                      then
-                        Error_Msg_N
-                          ("?return type of& does not correspond to C pointer",
-                           E);
+                        --  Check suspicious return of fat C pointer
+
+                        if Is_Access_Type (R_Type)
+                          and then Esize (R_Type) > Ttypes.System_Address_Size
+                        then
+                           Error_Msg_N
+                             ("?return type of& does not "
+                              & "correspond to C pointer!", E);
+
+                        --  Check suspicious return of boolean
+
+                        elsif Root_Type (R_Type) = Standard_Boolean
+                          and then Convention (R_Type) = Convention_Ada
+                        then
+                           Error_Msg_N
+                             ("?return type of & is an 8-bit "
+                              & "Ada Boolean, use char in C!", E);
 
-                     elsif Is_Array_Type (Etype (E))
+                        --  Check suspicious return tagged type
+
+                        elsif (Is_Tagged_Type (R_Type)
+                                or else (Is_Access_Type (R_Type)
+                                           and then
+                                             Is_Tagged_Type
+                                               (Designated_Type (R_Type))))
+                          and then Convention (E) = Convention_C
+                        then
+                           Error_Msg_N
+                             ("?return type of & does not "
+                              & "correspond to C type!", E);
+
+                        --  Check return of wrong convention subprogram pointer
+
+                        elsif Ekind (R_Type) = E_Access_Subprogram_Type
+                          and then not Has_Foreign_Convention (R_Type)
+                        then
+                           Error_Msg_N
+                             ("?& should return a foreign "
+                              & "convention subprogram pointer", E);
+                           Error_Msg_Sloc := Sloc (R_Type);
+                           Error_Msg_NE
+                             ("\?add Convention pragma to declaration of& #",
+                              E, R_Type);
+                        end if;
+                     end if;
+
+                     if Is_Array_Type (Etype (E))
                        and then not Is_Constrained (Etype (E))
                        and then not Is_Imported (E)
-                       and then Convention (E) in Foreign_Convention
+                       and then Has_Foreign_Convention (E)
                        and then Warn_On_Export_Import
                      then
                         Error_Msg_N
@@ -2451,14 +2584,14 @@ package body Freeze is
 
                Check_Address_Clause (E);
 
-               --  For imported objects, set Is_Public unless there is also
-               --  an address clause, which means that there is no external
-               --  symbol needed for the Import (Is_Public may still be set
-               --  for other unrelated reasons). Note that we delayed this
-               --  processing till freeze time so that we can be sure not
-               --  to set the flag if there is an address clause. If there
-               --  is such a clause, then the only purpose of the Import
-               --  pragma is to suppress implicit initialization.
+               --  For imported objects, set Is_Public unless there is also an
+               --  address clause, which means that there is no external symbol
+               --  needed for the Import (Is_Public may still be set for other
+               --  unrelated reasons). Note that we delayed this processing
+               --  till freeze time so that we can be sure not to set the flag
+               --  if there is an address clause. If there is such a clause,
+               --  then the only purpose of the Import pragma is to suppress
+               --  implicit initialization.
 
                if Is_Imported (E)
                  and then No (Address_Clause (E))
@@ -2507,7 +2640,7 @@ package body Freeze is
                then
                   Error_Msg_N
                     ("stand alone atomic constant must be " &
-                     "imported ('R'M C.6(13))", E);
+                     "imported (RM C.6(13))", E);
 
                elsif Has_Rep_Pragma (E, Name_Volatile)
                        or else
@@ -2664,16 +2797,16 @@ package body Freeze is
                end;
             end if;
 
-            --  If ancestor subtype present, freeze that first.
-            --  Note that this will also get the base type frozen.
+            --  If ancestor subtype present, freeze that first. Note that this
+            --  will also get the base type frozen.
 
             Atype := Ancestor_Subtype (E);
 
             if Present (Atype) then
                Freeze_And_Append (Atype, Loc, Result);
 
-            --  Otherwise freeze the base type of the entity before
-            --  freezing the entity itself (RM 13.14(15)).
+            --  Otherwise freeze the base type of the entity before freezing
+            --  the entity itself (RM 13.14(15)).
 
             elsif E /= Base_Type (E) then
                Freeze_And_Append (Base_Type (E), Loc, Result);
@@ -2944,9 +3077,16 @@ package body Freeze is
 
                   --  Size information of packed array type is copied to the
                   --  array type, since this is really the representation. But
-                  --  do not override explicit existing size values.
+                  --  do not override explicit existing size values. If the
+                  --  ancestor subtype is constrained the packed_array_type
+                  --  will be inherited from it, but the size may have been
+                  --  provided already, and must not be overridden either.
 
-                  if not Has_Size_Clause (E) then
+                  if not Has_Size_Clause (E)
+                    and then
+                      (No (Ancestor_Subtype (E))
+                        or else not Has_Size_Clause (Ancestor_Subtype (E)))
+                  then
                      Set_Esize     (E, Esize     (Packed_Array_Type (E)));
                      Set_RM_Size   (E, RM_Size   (Packed_Array_Type (E)));
                   end if;
@@ -2956,10 +3096,9 @@ package body Freeze is
                   end if;
                end if;
 
-               --  For non-packed arrays set the alignment of the array
-               --  to the alignment of the component type if it is unknown.
-               --  Skip this in the atomic case, since atomic arrays may
-               --  need larger alignments.
+               --  For non-packed arrays set the alignment of the array to the
+               --  alignment of the component type if it is unknown. Skip this
+               --  in atomic case (atomic arrays may need larger alignments).
 
                if not Is_Packed (E)
                  and then Unknown_Alignment (E)
@@ -3011,11 +3150,11 @@ package body Freeze is
                end;
             end if;
 
-            --  The equivalent type associated with a class-wide subtype
-            --  needs to be frozen to ensure that its layout is done.
-            --  Class-wide subtypes are currently only frozen on targets
-            --  requiring front-end layout (see New_Class_Wide_Subtype
-            --  and Make_CW_Equivalent_Type in exp_util.adb).
+            --  The equivalent type associated with a class-wide subtype needs
+            --  to be frozen to ensure that its layout is done. Class-wide
+            --  subtypes are currently only frozen on targets requiring
+            --  front-end layout (see New_Class_Wide_Subtype and
+            --  Make_CW_Equivalent_Type in exp_util.adb).
 
             if Ekind (E) = E_Class_Wide_Subtype
               and then Present (Equivalent_Type (E))
@@ -3024,10 +3163,10 @@ package body Freeze is
             end if;
 
          --  For a record (sub)type, freeze all the component types (RM
-         --  13.14(15). We test for E_Record_(sub)Type here, rather than
-         --  using Is_Record_Type, because we don't want to attempt the
-         --  freeze for the case of a private type with record extension
-         --  (we will do that later when the full type is frozen).
+         --  13.14(15). We test for E_Record_(sub)Type here, rather than using
+         --  Is_Record_Type, because we don't want to attempt the freeze for
+         --  the case of a private type with record extension (we will do that
+         --  later when the full type is frozen).
 
          elsif Ekind (E) = E_Record_Type
            or else  Ekind (E) = E_Record_Subtype
@@ -3148,8 +3287,8 @@ package body Freeze is
                            Set_Entity (F_Node, E);
 
                         else
-                           --  {Incomplete,Private}_Subtypes
-                           --  with Full_Views constrained by discriminants
+                           --  {Incomplete,Private}_Subtypes with Full_Views
+                           --  constrained by discriminants.
 
                            Set_Has_Delayed_Freeze (E, False);
                            Set_Freeze_Node (E, Empty);
@@ -3172,7 +3311,7 @@ package body Freeze is
                  Size_Known_At_Compile_Time (Full_View (E)));
 
                --  Size information is copied from the full view to the
-               --  incomplete or private view for consistency
+               --  incomplete or private view for consistency.
 
                --  We skip this is the full view is not a type. This is very
                --  strange of course, and can only happen as a result of
@@ -3215,7 +3354,7 @@ package body Freeze is
             Freeze_Subprogram (E);
 
             --  Ada 2005 (AI-326): Check wrong use of tag incomplete type
-            --
+
             --    type T is tagged;
             --    type Acc is access function (X : T) return T; -- ERROR
 
@@ -3346,10 +3485,10 @@ package body Freeze is
             --  AI-117), which will have occurred earlier (in Derive_Subprogram
             --  and New_Overloaded_Entity). Here we set the convention of
             --  primitives that are still convention Ada, which will ensure
-            --  that any new primitives inherit the type's convention.
-            --  Class-wide types can have a foreign convention inherited from
-            --  their specific type, but are excluded from this since they
-            --  don't have any associated primitives.
+            --  that any new primitives inherit the type's convention. Class-
+            --  wide types can have a foreign convention inherited from their
+            --  specific type, but are excluded from this since they don't have
+            --  any associated primitives.
 
             if Is_Tagged_Type (E)
               and then not Is_Class_Wide_Type (E)
@@ -4255,6 +4394,19 @@ package body Freeze is
 
             if UR_Is_Negative (Loval_Incl_EP) then
                Loval_Excl_EP := Loval_Incl_EP + Small;
+
+               --  If the value went from negative to zero, then we have the
+               --  case where Loval_Incl_EP is the model number just below
+               --  zero, so we want to stick to the negative value for the
+               --  base type to maintain the condition that the size will
+               --  include signed values.
+
+               if Typ = Btyp
+                 and then UR_Is_Zero (Loval_Excl_EP)
+               then
+                  Loval_Excl_EP := Loval_Incl_EP;
+               end if;
+
             else
                Loval_Excl_EP := Loval_Incl_EP;
             end if;
@@ -4874,7 +5026,9 @@ package body Freeze is
       --  be inlined. This is consistent with the restriction against using
       --  'Access or 'Address on an Inline_Always subprogram.
 
-      if Is_Dispatching_Operation (E) and then Is_Always_Inlined (E) then
+      if Is_Dispatching_Operation (E)
+        and then Has_Pragma_Inline_Always (E)
+      then
          Error_Msg_N
            ("pragma Inline_Always not allowed for dispatching subprograms", E);
       end if;

gcc/ada/g-ctrl_c.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                          G N A T . C T R L _ C                           --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                      Copyright (C) 2002-2007, 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- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body GNAT.Ctrl_C is
+
+   type C_Handler_Type is access procedure;
+   pragma Convention (C, C_Handler_Type);
+
+   Ada_Handler : Handler_Type;
+
+   procedure C_Handler;
+   pragma Convention (C, C_Handler);
+
+   procedure C_Handler is
+   begin
+      Ada_Handler.all;
+   end C_Handler;
+
+   procedure Install_Handler (Handler : Handler_Type) is
+      procedure Internal (Handler : C_Handler_Type);
+      pragma Import (C, Internal, "__gnat_install_int_handler");
+   begin
+      Ada_Handler := Handler;
+      Internal (C_Handler'Access);
+   end Install_Handler;
+
+end GNAT.Ctrl_C;

gcc/ada/g-ctrl_c.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                      Copyright (C) 2002-2006, AdaCore                    --
+--                      Copyright (C) 2002-2007, 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- --
@@ -42,12 +42,6 @@
 --  The behavior of this package when using tasking depends on the interaction
 --  between sigaction() and the thread library.
 
---  On most implementations, the interaction will be no different whether
---  tasking is involved or not. An exception is GNU/Linux systems where
---  each task/thread is considered as a separate process by the kernel,
---  meaning in particular that a Ctrl-C from the keyboard will be sent to
---  all tasks instead of only one, resulting in multiple calls to the handler.
-
 package GNAT.Ctrl_C is
 
    type Handler_Type is access procedure;
@@ -63,6 +57,5 @@ package GNAT.Ctrl_C is
    --  If Install_Handler has never been called, this procedure has no effect.
 
 private
-   pragma Import (C, Install_Handler, "__gnat_install_int_handler");
    pragma Import (C, Uninstall_Handler, "__gnat_uninstall_int_handler");
 end GNAT.Ctrl_C;

gcc/ada/i-vxwork-x86.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   S p e c                                --
 --                                                                          --
---                     Copyright (C) 1999-2006, AdaCore                     --
+--                     Copyright (C) 1999-2007, AdaCore                     --
 --                                                                          --
 -- GNARL 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,9 @@
 --  For complete documentation of the operations in this package, please
 --  consult the VxWorks Programmer's Manual and VxWorks Reference Manual.
 
+pragma Warnings (Off, "*foreign convention*");
+pragma Warnings (Off, "*add Convention pragma*");
+
 with System.VxWorks;
 
 package Interfaces.VxWorks is

gcc/ada/s-auxdec-vms_64.ads

@@ -465,28 +465,109 @@ private
    pragma Inline_Always (Fetch_From_Address);
    pragma Inline_Always (Assign_To_Address);
 
-   --  Synchronization related subprograms. These are declared to have
-   --  convention C so that the critical parameters are passed by reference.
+   --  Synchronization related subprograms. Mechanism is explicitly set
+   --  so that the critical parameters are passed by reference.
    --  Without this, the parameters are passed by copy, creating load/store
    --  race conditions. We also inline them, since this seems more in the
    --  spirit of the original (hardware intrinsic) routines.
 
-   pragma Convention (C, Clear_Interlocked);
+   pragma Export_Procedure
+     (Clear_Interlocked,
+      External        => "system__aux_dec__clear_interlocked__1",
+      Parameter_Types => (Boolean, Boolean),
+      Mechanism       => (Reference, Reference));
+   pragma Export_Procedure
+     (Clear_Interlocked,
+      External        => "system__aux_dec__clear_interlocked__2",
+      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
+      Mechanism       => (Reference, Reference, Value, Reference));
    pragma Inline_Always (Clear_Interlocked);
 
-   pragma Convention (C, Set_Interlocked);
+   pragma Export_Procedure
+     (Set_Interlocked,
+      External        => "system__aux_dec__set_interlocked__1",
+      Parameter_Types => (Boolean, Boolean),
+      Mechanism       => (Reference, Reference));
+   pragma Export_Procedure
+     (Set_Interlocked,
+      External        => "system__aux_dec__set_interlocked__2",
+      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
+      Mechanism       => (Reference, Reference, Value, Reference));
    pragma Inline_Always (Set_Interlocked);
 
-   pragma Convention (C, Add_Interlocked);
+   pragma Export_Procedure
+     (Add_Interlocked,
+      External        => "system__aux_dec__add_interlocked__1",
+      Mechanism       => (Value, Reference, Reference));
    pragma Inline_Always (Add_Interlocked);
 
-   pragma Convention (C, Add_Atomic);
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (Add_Atomic);
 
-   pragma Convention (C, And_Atomic);
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (And_Atomic);
 
-   pragma Convention (C, Or_Atomic);
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (Or_Atomic);
 
    --  Provide proper unchecked conversion definitions for transfer

gcc/ada/s-auxdec.ads

@@ -455,28 +455,109 @@ private
    pragma Inline_Always (Fetch_From_Address);
    pragma Inline_Always (Assign_To_Address);
 
-   --  Synchronization related subprograms. These are declared to have
-   --  convention C so that the critical parameters are passed by reference.
+   --  Synchronization related subprograms. Mechanism is explicitly set
+   --  so that the critical parameters are passed by reference.
    --  Without this, the parameters are passed by copy, creating load/store
    --  race conditions. We also inline them, since this seems more in the
    --  spirit of the original (hardware intrinsic) routines.
 
-   pragma Convention (C, Clear_Interlocked);
+   pragma Export_Procedure
+     (Clear_Interlocked,
+      External        => "system__aux_dec__clear_interlocked__1",
+      Parameter_Types => (Boolean, Boolean),
+      Mechanism       => (Reference, Reference));
+   pragma Export_Procedure
+     (Clear_Interlocked,
+      External        => "system__aux_dec__clear_interlocked__2",
+      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
+      Mechanism       => (Reference, Reference, Value, Reference));
    pragma Inline_Always (Clear_Interlocked);
 
-   pragma Convention (C, Set_Interlocked);
+   pragma Export_Procedure
+     (Set_Interlocked,
+      External        => "system__aux_dec__set_interlocked__1",
+      Parameter_Types => (Boolean, Boolean),
+      Mechanism       => (Reference, Reference));
+   pragma Export_Procedure
+     (Set_Interlocked,
+      External        => "system__aux_dec__set_interlocked__2",
+      Parameter_Types => (Boolean, Boolean, Natural, Boolean),
+      Mechanism       => (Reference, Reference, Value, Reference));
    pragma Inline_Always (Set_Interlocked);
 
-   pragma Convention (C, Add_Interlocked);
+   pragma Export_Procedure
+     (Add_Interlocked,
+      External        => "system__aux_dec__add_interlocked__1",
+      Mechanism       => (Value, Reference, Reference));
    pragma Inline_Always (Add_Interlocked);
 
-   pragma Convention (C, Add_Atomic);
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Add_Atomic,
+      External        => "system__aux_dec__add_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (Add_Atomic);
 
-   pragma Convention (C, And_Atomic);
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (And_Atomic,
+      External => "system__aux_dec__and_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism => (Reference, Value));
+   pragma Export_Procedure
+     (And_Atomic,
+      External        => "system__aux_dec__and_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (And_Atomic);
 
-   pragma Convention (C, Or_Atomic);
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__1",
+      Parameter_Types => (Aligned_Integer, Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__2",
+      Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__3",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer),
+      Mechanism       => (Reference, Value));
+   pragma Export_Procedure
+     (Or_Atomic,
+      External        => "system__aux_dec__or_atomic__4",
+      Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
+                          Long_Integer, Boolean),
+      Mechanism       => (Reference, Value, Value, Reference, Reference));
    pragma Inline_Always (Or_Atomic);
 
    --  Provide proper unchecked conversion definitions for transfer

gcc/ada/s-interr-sigaction.adb

@@ -117,6 +117,7 @@ package body System.Interrupts is
    --  that contain interrupt handlers.
 
    procedure Signal_Handler (Sig : Interrupt_ID);
+   pragma Convention (C, Signal_Handler);
    --  This procedure is used to handle all the signals
 
    --  Type and Head, Tail of the list containing Registered Interrupt
@@ -142,6 +143,7 @@ package body System.Interrupts is
    --  Always consider a null handler as registered.
 
    type Handler_Ptr is access procedure (Sig : Interrupt_ID);
+   pragma Convention (C, Handler_Ptr);
 
    function TISR is new Ada.Unchecked_Conversion (Handler_Ptr, isr_address);
 

gcc/ada/s-intman-vms.adb

@@ -59,7 +59,7 @@ package body System.Interrupt_Management is
 
       Sys_Crembx
         (Status => Status,
-         Prmflg => False,
+         Prmflg => 0,
          Chan   => Rcv_Interrupt_Chan,
          Maxmsg => Interrupt_ID'Size,
          Bufquo => Interrupt_Bufquo,

gcc/ada/s-osinte-aix.ads

@@ -266,6 +266,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -506,8 +507,8 @@ package System.OS_Interface is
    function pthread_getspecific (key : pthread_key_t) return System.Address;
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
-   type destructor_pointer is access
-      procedure (arg : System.Address);
+   type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-darwin.ads

@@ -239,6 +239,8 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
+
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
 
@@ -475,6 +477,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-freebsd.ads

@@ -267,6 +267,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -572,8 +573,8 @@ package System.OS_Interface is
    function pthread_getspecific (key : pthread_key_t) return System.Address;
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
-   type destructor_pointer is access
-      procedure (arg : System.Address);
+   type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-hpux-dce.ads

@@ -133,6 +133,7 @@ package System.OS_Interface is
    type sigset_t is private;
 
    type isr_address is access procedure (sig : int);
+   pragma Convention (C, isr_address);
 
    function intr_attach (sig : int; handler : isr_address) return long;
 
@@ -238,6 +239,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -426,6 +428,7 @@ package System.OS_Interface is
    --  DCE_THREADS has a nonstandard pthread_getspecific
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-hpux.ads

@@ -256,6 +256,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -489,6 +490,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-irix.ads

@@ -243,6 +243,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -445,6 +446,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-linux-hppa.ads

@@ -8,7 +8,7 @@
 --                          (GNU/Linux-HPPA Version)                        --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2007, Free Software Foundation, Inc.      --
+--          Copyright (C) 1995-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -255,7 +255,7 @@ package System.OS_Interface is
 
    function To_Target_Priority
      (Prio : System.Any_Priority) return Interfaces.C.int;
-   --  Maps System.Any_Priority to a POSIX priority.
+   --  Maps System.Any_Priority to a POSIX priority
 
    -------------
    -- Process --
@@ -275,6 +275,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -455,6 +456,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-lynxos-3.ads

@@ -211,7 +211,7 @@ package System.OS_Interface is
 
    function To_Target_Priority
      (Prio : System.Any_Priority) return Interfaces.C.int;
-   --  Maps System.Any_Priority to a POSIX priority.
+   --  Maps System.Any_Priority to a POSIX priority
 
    -------------
    -- Process --
@@ -241,6 +241,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -266,7 +267,7 @@ package System.OS_Interface is
    -----------
 
    Stack_Base_Available : constant Boolean := False;
-   --  Indicates wether the stack base is available on this target.
+   --  Indicates wether the stack base is available on this target
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
@@ -484,6 +485,7 @@ package System.OS_Interface is
    --  LynxOS has a non standard pthread_getspecific
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-lynxos.ads

@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2007, Free Software Foundation, Inc.      --
+--          Copyright (C) 1995-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -253,6 +253,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -275,7 +276,7 @@ package System.OS_Interface is
    -----------
 
    Stack_Base_Available : constant Boolean := False;
-   --  Indicates whether the stack base is available on this target.
+   --  Indicates whether the stack base is available on this target
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
@@ -484,6 +485,7 @@ package System.OS_Interface is
    pragma Import (C, st_getspecific, "st_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function st_keycreate
      (destructor : destructor_pointer;

gcc/ada/s-osinte-mingw.ads

@@ -133,6 +133,7 @@ package System.OS_Interface is
    type sigset_t is private;
 
    type isr_address is access procedure (sig : int);
+   pragma Convention (C, isr_address);
 
    function intr_attach (sig : int; handler : isr_address) return long;
    pragma Import (C, intr_attach, "signal");
@@ -206,6 +207,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);

gcc/ada/s-osinte-solaris-posix.ads

@@ -220,7 +220,7 @@ package System.OS_Interface is
 
    function To_Target_Priority
      (Prio : System.Any_Priority) return Interfaces.C.int;
-   --  Maps System.Any_Priority to a POSIX priority.
+   --  Maps System.Any_Priority to a POSIX priority
 
    -------------
    -- Process --
@@ -247,6 +247,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -271,7 +272,7 @@ package System.OS_Interface is
    -----------
 
    Stack_Base_Available : constant Boolean := False;
-   --  Indicates whether the stack base is available on this target.
+   --  Indicates whether the stack base is available on this target
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
@@ -477,6 +478,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-solaris.ads

@@ -299,6 +299,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);

gcc/ada/s-osinte-tru64.ads

@@ -247,6 +247,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
      Ada.Unchecked_Conversion (System.Address, Thread_Body);
@@ -484,6 +485,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "__pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-vms.ads

@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2007, Free Software Foundation, Inc.      --
+--          Copyright (C) 1995-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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,12 +42,13 @@
 
 with Interfaces.C;
 with Ada.Unchecked_Conversion;
+with System.Aux_DEC;
 
 package System.OS_Interface is
    pragma Preelaborate;
 
    pragma Linker_Options ("--for-linker=sys$library:pthread$rtl.exe");
-   --  Link in the DEC threads library.
+   --  Link in the DEC threads library
 
    --  pragma Linker_Options ("--for-linker=/threads_enable");
    --  Enable upcalls and multiple kernel threads.
@@ -80,7 +81,7 @@ package System.OS_Interface is
 
    subtype Interrupt_Number_Type is unsigned_long;
 
-   --  OpenVMS system services return values of type Cond_Value_Type.
+   --  OpenVMS system services return values of type Cond_Value_Type
 
    subtype Cond_Value_Type is unsigned_long;
    subtype Short_Cond_Value_Type is unsigned_short;
@@ -92,6 +93,7 @@ package System.OS_Interface is
    end record;
 
    type AST_Handler is access procedure (Param : Address);
+   pragma Convention (C, AST_Handler);
    No_AST_Handler : constant AST_Handler := null;
 
    CMB_M_READONLY  : constant := 16#00000001#;
@@ -173,7 +175,7 @@ package System.OS_Interface is
    --
    procedure Sys_Crembx
      (Status : out Cond_Value_Type;
-      Prmflg : Boolean;
+      Prmflg : unsigned_char;
       Chan   : out unsigned_short;
       Maxmsg : unsigned_long := 0;
       Bufquo : unsigned_long := 0;
@@ -184,7 +186,7 @@ package System.OS_Interface is
    pragma Interface (External, Sys_Crembx);
    pragma Import_Valued_Procedure
      (Sys_Crembx, "SYS$CREMBX",
-      (Cond_Value_Type, Boolean,        unsigned_short,
+      (Cond_Value_Type, unsigned_char,  unsigned_short,
        unsigned_long,   unsigned_long,  unsigned_short,
        unsigned_short,  String,         unsigned_long),
       (Value,           Value,          Reference,
@@ -360,9 +362,10 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    function Thread_Body_Access is new
-     Ada.Unchecked_Conversion (System.Address, Thread_Body);
+     Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -569,6 +572,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "PTHREAD_GETSPECIFIC");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;

gcc/ada/s-osinte-vxworks.ads

@@ -137,6 +137,7 @@ package System.OS_Interface is
    pragma Import (C, sigaction, "sigaction");
 
    type isr_address is access procedure (sig : int);
+   pragma Convention (C, isr_address);
 
    function c_signal (sig : Signal; handler : isr_address) return isr_address;
    pragma Import (C, c_signal, "signal");

gcc/ada/s-osinte-vxworks6.ads

@@ -179,6 +179,7 @@ package System.OS_Interface is
    pragma Import (C, sigaction, "sigaction");
 
    type isr_address is access procedure (sig : int);
+   pragma Convention (C, isr_address);
 
    function c_signal (sig : Signal; handler : isr_address) return isr_address;
    pragma Import (C, c_signal, "signal");

gcc/ada/s-taprop-vms.adb

@@ -54,6 +54,9 @@ with System.Soft_Links;
 --  used for Get_Exc_Stack_Addr
 --           Abort_Defer/Undefer
 
+with System.Aux_DEC;
+--  used for Short_Address
+
 with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
@@ -147,6 +150,7 @@ package body System.Task_Primitives.Operations is
    --  Replace System.Soft_Links.Get_Exc_Stack_Addr_NT
 
    procedure Timer_Sleep_AST (ID : Address);
+   pragma Convention (C, Timer_Sleep_AST);
    --  Signal the condition variable when AST fires
 
    procedure Timer_Sleep_AST (ID : Address) is
@@ -822,7 +826,7 @@ package body System.Task_Primitives.Operations is
       Result     : Interfaces.C.int;
 
       function Thread_Body_Access is new
-        Ada.Unchecked_Conversion (System.Address, Thread_Body);
+        Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
 
    begin
       --  Since the initial signal mask of a thread is inherited from the

gcc/ada/s-tpopde-vms.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 2000-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2000-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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,6 +38,7 @@ with System.Aux_DEC;
 package System.Task_Primitives.Operations.DEC is
 
    procedure Interrupt_AST_Handler (ID : Address);
+   pragma Convention (C, Interrupt_AST_Handler);
    --  Handles the AST for Ada95 Interrupts.
 
    procedure RMS_AST_Handler (ID : Address);