[multiple changes]
2012-04-02 Yannick Moy <moy@adacore.com> * osint.adb, osint.ads (Add_Default_Search_Dirs): Add library search dirs in file specified with option -gnateO. 2012-04-02 Robert Dewar <dewar@adacore.com> * sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb: Minor reformatting. 2012-04-02 Olivier Hainque <hainque@adacore.com> * g-sse.ads: Add x86-solaris and x86_64-darwin to the set of platforms where the use of this spec is supported. Add current year to the copyright notice. * gcc-interfaces/Makefile.in: Add g-sse.o and g-ssvety.o to EXTRA_GNATRTL_NONTASKING_OBJS on x86 32/64 targets that support it and where they were missing (x86-solaris, x86-freebsd, x86_64-freebsd, and x86-darwin). 2012-04-02 Gary Dismukes <dismukes@adacore.com> * bindgen.adb (Gen_Ada_Init): When compiling for the AAMP small library, where we no longer suppress the Standard_Library, generate an empty body rather than the usual generation of assignments to imported globals, since those aren't present in the small library. 2012-04-02 Ed Schonberg <schonberg@adacore.com> * sinfo.ads: Minor documentation fix. 2012-04-02 Hristian Kirtchev <kirtchev@adacore.com> * sem_res.adb (Resolve_Conditional_Expression): Add local variables Else_Typ and Then_Typ. Add missing type conversions to the "then" and "else" expressions when their respective types are scalar. 2012-04-02 Vincent Pucci <pucci@adacore.com> * exp_ch9.adb: Reordering of the local subprograms. New Table for the lock free implementation that maps each protected subprograms with the protected component it references. (Allow_Lock_Free_Implementation): New routine. Check if the protected body enables the lock free implementation. (Build_Lock_Free_Protected_Subprogram_Body): New routine. (Build_Lock_Free_Unprotected_Subprogram_Body): New routine. (Comp_Of): New routine. * Makefile.rtl: Add s-atopri.o * debug.adb: New compiler debug flag -gnatd9 for lock free implementation. * rtsfind.ads: RE_Atomic_Compare_Exchange_8, RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32, RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8, RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64, RE_Uint8, RE_Uint16, RE_Uint32, RE_Uint64 added. * s-atropi.ads: New file. Defines atomic primitives used by the lock free implementation. From-SVN: r186076
This commit is contained in:
Arnaud Charlet
parent
804670f120
commit
36504e5f46
17 changed files with 1327 additions and 205 deletions
|
|
@ -1,3 +1,62 @@
|
|||
2012-04-02 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* osint.adb, osint.ads (Add_Default_Search_Dirs): Add library
|
||||
search dirs in file specified with option -gnateO.
|
||||
|
||||
2012-04-02 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch5.adb, exp_util.adb, sem_util.adb, exp_ch4.adb: Minor
|
||||
reformatting.
|
||||
|
||||
2012-04-02 Olivier Hainque <hainque@adacore.com>
|
||||
|
||||
* g-sse.ads: Add x86-solaris and x86_64-darwin to the set of
|
||||
platforms where the use of this spec is supported. Add current
|
||||
year to the copyright notice.
|
||||
* gcc-interfaces/Makefile.in: Add g-sse.o and g-ssvety.o to
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS on x86 32/64 targets that support
|
||||
it and where they were missing (x86-solaris, x86-freebsd,
|
||||
x86_64-freebsd, and x86-darwin).
|
||||
|
||||
2012-04-02 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* bindgen.adb (Gen_Ada_Init): When compiling for the AAMP small
|
||||
library, where we no longer suppress the Standard_Library,
|
||||
generate an empty body rather than the usual generation of
|
||||
assignments to imported globals, since those aren't present in
|
||||
the small library.
|
||||
|
||||
2012-04-02 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sinfo.ads: Minor documentation fix.
|
||||
|
||||
2012-04-02 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* sem_res.adb (Resolve_Conditional_Expression): Add local variables
|
||||
Else_Typ and Then_Typ. Add missing type conversions to the "then" and
|
||||
"else" expressions when their respective types are scalar.
|
||||
|
||||
2012-04-02 Vincent Pucci <pucci@adacore.com>
|
||||
|
||||
* exp_ch9.adb: Reordering of the local subprograms. New Table
|
||||
for the lock free implementation that maps each protected
|
||||
subprograms with the protected component it references.
|
||||
(Allow_Lock_Free_Implementation): New routine. Check if
|
||||
the protected body enables the lock free implementation.
|
||||
(Build_Lock_Free_Protected_Subprogram_Body): New routine.
|
||||
(Build_Lock_Free_Unprotected_Subprogram_Body): New routine.
|
||||
(Comp_Of): New routine.
|
||||
* Makefile.rtl: Add s-atopri.o
|
||||
* debug.adb: New compiler debug flag -gnatd9 for lock free
|
||||
implementation.
|
||||
* rtsfind.ads: RE_Atomic_Compare_Exchange_8,
|
||||
RE_Atomic_Compare_Exchange_16, RE_Atomic_Compare_Exchange_32,
|
||||
RE_Atomic_Compare_Exchange_64, RE_Atomic_Load_8,
|
||||
RE_Atomic_Load_16, RE_Atomic_Load_32, RE_Atomic_Load_64, RE_Uint8,
|
||||
RE_Uint16, RE_Uint32, RE_Uint64 added.
|
||||
* s-atropi.ads: New file. Defines atomic primitives used
|
||||
by the lock free implementation.
|
||||
|
||||
2012-04-02 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.
|
||||
|
|
|
|||
|
|
@ -479,6 +479,7 @@ GNATRTL_NONTASKING_OBJS= \
|
|||
s-assert$(objext) \
|
||||
s-atacco$(objext) \
|
||||
s-atocou$(objext) \
|
||||
s-atopri$(objext) \
|
||||
s-auxdec$(objext) \
|
||||
s-bitops$(objext) \
|
||||
s-boarop$(objext) \
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -511,6 +511,14 @@ package body Bindgen is
|
|||
if CodePeer_Mode then
|
||||
WBI (" begin");
|
||||
|
||||
-- When compiling for the AAMP small library, where the standard library
|
||||
-- is no longer suppressed, we still want to exclude the setting of the
|
||||
-- various imported globals, which aren't present for that library.
|
||||
|
||||
elsif AAMP_On_Target and then Configurable_Run_Time_On_Target then
|
||||
WBI (" begin");
|
||||
WBI (" null;");
|
||||
|
||||
-- If the standard library is suppressed, then the only global variables
|
||||
-- that might be needed (by the Ravenscar profile) are the priority and
|
||||
-- the processor for the environment task.
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@ package body Debug is
|
|||
-- d6 Default access unconstrained to thin pointers
|
||||
-- d7 Do not output version & file time stamp in -gnatv or -gnatl mode
|
||||
-- d8 Force opposite endianness in packed stuff
|
||||
-- d9
|
||||
-- d9 Allow lock free implementation
|
||||
|
||||
-- Debug flags for binder (GNATBIND)
|
||||
|
||||
|
|
@ -710,6 +710,9 @@ package body Debug is
|
|||
-- opposite endianness from the actual correct value. Useful in
|
||||
-- testing out code generation from the packed routines.
|
||||
|
||||
-- d9 This allows lock free implementation for protected objects
|
||||
-- (see Exp_Ch9).
|
||||
|
||||
------------------------------------------
|
||||
-- Documentation for Binder Debug Flags --
|
||||
------------------------------------------
|
||||
|
|
|
|||
|
|
@ -7832,9 +7832,7 @@ package body Exp_Ch4 is
|
|||
begin
|
||||
-- Do validity check if validity checking operands
|
||||
|
||||
if Validity_Checks_On
|
||||
and then Validity_Check_Operands
|
||||
then
|
||||
if Validity_Checks_On and then Validity_Check_Operands then
|
||||
Ensure_Valid (Operand);
|
||||
end if;
|
||||
|
||||
|
|
@ -7866,7 +7864,7 @@ package body Exp_Ch4 is
|
|||
-- end if;
|
||||
-- end loop;
|
||||
|
||||
-- Conversely, an existentially quantified expression:
|
||||
-- Similarly, an existentially quantified expression:
|
||||
|
||||
-- for some X in range => Cond
|
||||
|
||||
|
|
@ -7957,7 +7955,6 @@ package body Exp_Ch4 is
|
|||
Make_Expression_With_Actions (Loc,
|
||||
Expression => New_Occurrence_Of (Flag, Loc),
|
||||
Actions => Actions));
|
||||
|
||||
Analyze_And_Resolve (N, Standard_Boolean);
|
||||
end Expand_N_Quantified_Expression;
|
||||
|
||||
|
|
|
|||
1221
gcc/ada/exp_ch9.adb
1221
gcc/ada/exp_ch9.adb
File diff suppressed because it is too large
Load diff
|
|
@ -3948,8 +3948,7 @@ package body Exp_Util is
|
|||
(Obj_Id : Entity_Id) return Boolean
|
||||
is
|
||||
function Is_Controlled_Function_Call (N : Node_Id) return Boolean;
|
||||
-- Determine whether a particular node denotes a controlled function
|
||||
-- call.
|
||||
-- Determine if particular node denotes a controlled function call
|
||||
|
||||
function Is_Displace_Call (N : Node_Id) return Boolean;
|
||||
-- Determine whether a particular node is a call to Ada.Tags.Displace.
|
||||
|
|
@ -4065,7 +4064,7 @@ package body Exp_Util is
|
|||
and then Is_Displace_Call (Renamed_Object (Obj_Id))
|
||||
and then
|
||||
(Is_Controlled_Function_Call (Expression (Orig_Decl))
|
||||
or else Is_Source_Object (Expression (Orig_Decl)));
|
||||
or else Is_Source_Object (Expression (Orig_Decl)));
|
||||
end Is_Displacement_Of_Object_Or_Function_Result;
|
||||
|
||||
------------------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2009-2012, 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- --
|
||||
|
|
@ -40,6 +40,8 @@
|
|||
|
||||
-- GNU/Linux x86 and x86_64
|
||||
-- Windows XP/Vista x86 and x86_64
|
||||
-- Solaris x86
|
||||
-- Darwin x86_64
|
||||
|
||||
-- This unit exposes vector _component_ types together with general comments
|
||||
-- on the binding contents.
|
||||
|
|
|
|||
|
|
@ -1083,6 +1083,8 @@ ifeq ($(strip $(filter-out %86 %x86_64 solaris2%,$(arch) $(osys))),)
|
|||
|
||||
TOOLS_TARGET_PAIRS=mlib-tgt-specific.adb<mlib-tgt-specific-solaris.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB = -lposix4 -lthread
|
||||
MISCLIB = -lposix4 -lnsl -lsocket
|
||||
|
|
@ -1175,6 +1177,8 @@ ifeq ($(strip $(filter-out %86 kfreebsd%,$(arch) $(osys))),)
|
|||
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB = -lpthread
|
||||
GNATLIB_SHARED = gnatlib-shared-dual
|
||||
|
|
@ -1231,6 +1235,8 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
|
|||
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb
|
||||
GNATLIB_SHARED = gnatlib-shared-dual
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB= -lpthread
|
||||
GMEM_LIB = gmemlib
|
||||
|
|
@ -1259,6 +1265,8 @@ ifeq ($(strip $(filter-out %86_64 freebsd%,$(arch) $(osys))),)
|
|||
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb
|
||||
GNATLIB_SHARED = gnatlib-shared-dual
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB= -lpthread
|
||||
GMEM_LIB = gmemlib
|
||||
|
|
@ -2160,6 +2168,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
|
|||
$(X86_TARGET_PAIRS) \
|
||||
system.ads<system-darwin-x86.ads
|
||||
endif
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
endif
|
||||
|
||||
ifeq ($(strip $(filter-out %x86_64,$(arch))),)
|
||||
|
|
@ -2178,6 +2188,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
|
|||
$(X86_64_TARGET_PAIRS) \
|
||||
system.ads<system-darwin-x86_64.ads
|
||||
endif
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
endif
|
||||
|
||||
ifeq ($(strip $(filter-out powerpc%,$(arch))),)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -444,6 +444,15 @@ package body Osint is
|
|||
-- Start of processing for Add_Default_Search_Dirs
|
||||
|
||||
begin
|
||||
-- If there was a -gnateO switch, add all object directories from the
|
||||
-- file given in argument to the library search list.
|
||||
|
||||
if Object_Path_File_Name /= null then
|
||||
Path_File_Name := String_Access (Object_Path_File_Name);
|
||||
pragma Assert (Path_File_Name'Length > 0);
|
||||
Get_Dirs_From_File (Additional_Source_Dir => False);
|
||||
end if;
|
||||
|
||||
-- After the locations specified on the command line, the next places
|
||||
-- to look for files are the directories specified by the appropriate
|
||||
-- environment variable. Get this value, extract the directory names
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2012, 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- --
|
||||
|
|
@ -324,7 +324,8 @@ package Osint is
|
|||
|
||||
procedure Add_Default_Search_Dirs;
|
||||
-- This routine adds the default search dirs indicated by the environment
|
||||
-- variables and sdefault package.
|
||||
-- variables and sdefault package, as well as the library search dirs set
|
||||
-- by option -gnateO for GNAT2WHY.
|
||||
|
||||
procedure Add_Lib_Search_Dir (Dir : String);
|
||||
-- Add Dir at the end of the library file search path
|
||||
|
|
|
|||
|
|
@ -211,6 +211,7 @@ package Rtsfind is
|
|||
System_Arith_64,
|
||||
System_AST_Handling,
|
||||
System_Assertions,
|
||||
System_Atomic_Primitives,
|
||||
System_Aux_DEC,
|
||||
System_Bit_Ops,
|
||||
System_Boolean_Array_Operations,
|
||||
|
|
@ -730,6 +731,19 @@ package Rtsfind is
|
|||
RE_Assert_Failure, -- System.Assertions
|
||||
RE_Raise_Assert_Failure, -- System.Assertions
|
||||
|
||||
RE_Atomic_Compare_Exchange_8, -- System.Atomic_Primitives
|
||||
RE_Atomic_Compare_Exchange_16, -- System.Atomic_Primitives
|
||||
RE_Atomic_Compare_Exchange_32, -- System.Atomic_Primitives
|
||||
RE_Atomic_Compare_Exchange_64, -- System.Atomic_Primitives
|
||||
RE_Atomic_Load_8, -- System.Atomic_Primitives
|
||||
RE_Atomic_Load_16, -- System.Atomic_Primitives
|
||||
RE_Atomic_Load_32, -- System.Atomic_Primitives
|
||||
RE_Atomic_Load_64, -- System.Atomic_Primitives
|
||||
RE_Uint8, -- System.Atomic_Primitives
|
||||
RE_Uint16, -- System.Atomic_Primitives
|
||||
RE_Uint32, -- System.Atomic_Primitives
|
||||
RE_Uint64, -- System.Atomic_Primitives
|
||||
|
||||
RE_AST_Handler, -- System.Aux_DEC
|
||||
RE_Import_Value, -- System.Aux_DEC
|
||||
RE_No_AST_Handler, -- System.Aux_DEC
|
||||
|
|
@ -1938,6 +1952,19 @@ package Rtsfind is
|
|||
RE_Assert_Failure => System_Assertions,
|
||||
RE_Raise_Assert_Failure => System_Assertions,
|
||||
|
||||
RE_Atomic_Compare_Exchange_8 => System_Atomic_Primitives,
|
||||
RE_Atomic_Compare_Exchange_16 => System_Atomic_Primitives,
|
||||
RE_Atomic_Compare_Exchange_32 => System_Atomic_Primitives,
|
||||
RE_Atomic_Compare_Exchange_64 => System_Atomic_Primitives,
|
||||
RE_Atomic_Load_8 => System_Atomic_Primitives,
|
||||
RE_Atomic_Load_16 => System_Atomic_Primitives,
|
||||
RE_Atomic_Load_32 => System_Atomic_Primitives,
|
||||
RE_Atomic_Load_64 => System_Atomic_Primitives,
|
||||
RE_Uint8 => System_Atomic_Primitives,
|
||||
RE_Uint16 => System_Atomic_Primitives,
|
||||
RE_Uint32 => System_Atomic_Primitives,
|
||||
RE_Uint64 => System_Atomic_Primitives,
|
||||
|
||||
RE_AST_Handler => System_Aux_DEC,
|
||||
RE_Import_Value => System_Aux_DEC,
|
||||
RE_No_AST_Handler => System_Aux_DEC,
|
||||
|
|
|
|||
120
gcc/ada/s-atopri.ads
Normal file
120
gcc/ada/s-atopri.ads
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . A T O M I C _ P R I M I T I V E S --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2012, 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- --
|
||||
-- ware Foundation; either version 3, 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. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
package System.Atomic_Primitives is
|
||||
pragma Preelaborate;
|
||||
|
||||
type uint8 is mod 2**8
|
||||
with Size => 8;
|
||||
|
||||
type uint16 is mod 2**16
|
||||
with Size => 16;
|
||||
|
||||
type uint32 is mod 2**32
|
||||
with Size => 32;
|
||||
|
||||
type uint64 is mod 2**64
|
||||
with Size => 64;
|
||||
|
||||
Relaxed : constant := 0;
|
||||
Consume : constant := 1;
|
||||
Acquire : constant := 2;
|
||||
Release : constant := 3;
|
||||
Acq_Rel : constant := 4;
|
||||
Seq_Cst : constant := 5;
|
||||
Last : constant := 6;
|
||||
|
||||
subtype Mem_Model is Integer range Relaxed .. Last;
|
||||
|
||||
function Atomic_Compare_Exchange_8
|
||||
(X : Address;
|
||||
X_Old : uint8;
|
||||
X_Copy : uint8) return Boolean;
|
||||
pragma Import (Intrinsic,
|
||||
Atomic_Compare_Exchange_8,
|
||||
"__sync_bool_compare_and_swap_1");
|
||||
|
||||
-- ??? Should use __atomic_compare_exchange_1 (doesn't work yet):
|
||||
-- function Atomic_Compare_Exchange_8
|
||||
-- (X : Address;
|
||||
-- X_Old : Address;
|
||||
-- X_Copy : uint8;
|
||||
-- Success_Model : Mem_Model := Seq_Cst;
|
||||
-- Failure_Model : Mem_Model := Seq_Cst) return Boolean;
|
||||
-- pragma Import (Intrinsic,
|
||||
-- Atomic_Compare_Exchange_8,
|
||||
-- "__atomic_compare_exchange_1");
|
||||
|
||||
function Atomic_Compare_Exchange_16
|
||||
(X : Address;
|
||||
X_Old : uint16;
|
||||
X_Copy : uint16) return Boolean;
|
||||
pragma Import (Intrinsic,
|
||||
Atomic_Compare_Exchange_16,
|
||||
"__sync_bool_compare_and_swap_2");
|
||||
|
||||
function Atomic_Compare_Exchange_32
|
||||
(X : Address;
|
||||
X_Old : uint32;
|
||||
X_Copy : uint32) return Boolean;
|
||||
pragma Import (Intrinsic,
|
||||
Atomic_Compare_Exchange_32,
|
||||
"__sync_bool_compare_and_swap_4");
|
||||
|
||||
function Atomic_Compare_Exchange_64
|
||||
(X : Address;
|
||||
X_Old : uint64;
|
||||
X_Copy : uint64) return Boolean;
|
||||
pragma Import (Intrinsic,
|
||||
Atomic_Compare_Exchange_64,
|
||||
"__sync_bool_compare_and_swap_8");
|
||||
|
||||
function Atomic_Load_8
|
||||
(X : Address;
|
||||
Model : Mem_Model := Seq_Cst) return uint8;
|
||||
pragma Import (Intrinsic, Atomic_Load_8, "__atomic_load_1");
|
||||
|
||||
function Atomic_Load_16
|
||||
(X : Address;
|
||||
Model : Mem_Model := Seq_Cst) return uint16;
|
||||
pragma Import (Intrinsic, Atomic_Load_16, "__atomic_load_2");
|
||||
|
||||
function Atomic_Load_32
|
||||
(X : Address;
|
||||
Model : Mem_Model := Seq_Cst) return uint32;
|
||||
pragma Import (Intrinsic, Atomic_Load_32, "__atomic_load_4");
|
||||
|
||||
function Atomic_Load_64
|
||||
(X : Address;
|
||||
Model : Mem_Model := Seq_Cst) return uint64;
|
||||
pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
|
||||
|
||||
end System.Atomic_Primitives;
|
||||
|
|
@ -1666,6 +1666,9 @@ package body Sem_Ch5 is
|
|||
|
||||
if not Is_Entity_Name (Iter_Name)
|
||||
and then (Nkind (Parent (N)) /= N_Quantified_Expression
|
||||
|
||||
-- The following two tests need comments ???
|
||||
|
||||
or else Operating_Mode = Check_Semantics
|
||||
or else Alfa_Mode)
|
||||
then
|
||||
|
|
|
|||
|
|
@ -2624,10 +2624,10 @@ package body Sem_Res is
|
|||
-- an error. We can't do this earlier, because it would cause legal
|
||||
-- cases to get errors (when some other type has an abstract "+").
|
||||
|
||||
if Ada_Version >= Ada_2005 and then
|
||||
Nkind (N) in N_Op and then
|
||||
Is_Overloaded (N) and then
|
||||
Is_Universal_Numeric_Type (Etype (Entity (N)))
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Nkind (N) in N_Op
|
||||
and then Is_Overloaded (N)
|
||||
and then Is_Universal_Numeric_Type (Etype (Entity (N)))
|
||||
then
|
||||
Get_First_Interp (N, I, It);
|
||||
while Present (It.Typ) loop
|
||||
|
|
@ -6118,15 +6118,36 @@ package body Sem_Res is
|
|||
Condition : constant Node_Id := First (Expressions (N));
|
||||
Then_Expr : constant Node_Id := Next (Condition);
|
||||
Else_Expr : Node_Id := Next (Then_Expr);
|
||||
Else_Typ : Entity_Id;
|
||||
Then_Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
Resolve (Condition, Any_Boolean);
|
||||
Resolve (Then_Expr, Typ);
|
||||
Then_Typ := Etype (Then_Expr);
|
||||
|
||||
-- When the "then" and "else" expressions are of a scalar type, insert
|
||||
-- a conversion to ensure the generation of a constraint check.
|
||||
|
||||
if Is_Scalar_Type (Then_Typ)
|
||||
and then Then_Typ /= Typ
|
||||
then
|
||||
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
|
||||
Analyze_And_Resolve (Then_Expr, Typ);
|
||||
end if;
|
||||
|
||||
-- If ELSE expression present, just resolve using the determined type
|
||||
|
||||
if Present (Else_Expr) then
|
||||
Resolve (Else_Expr, Typ);
|
||||
Else_Typ := Etype (Else_Expr);
|
||||
|
||||
if Is_Scalar_Type (Else_Typ)
|
||||
and then Else_Typ /= Typ
|
||||
then
|
||||
Rewrite (Else_Expr, Convert_To (Typ, Else_Expr));
|
||||
Analyze_And_Resolve (Else_Expr, Typ);
|
||||
end if;
|
||||
|
||||
-- If no ELSE expression is present, root type must be Standard.Boolean
|
||||
-- and we provide a Standard.True result converted to the appropriate
|
||||
|
|
|
|||
|
|
@ -740,15 +740,16 @@ package body Sem_Util is
|
|||
N : Node_Id) return Entity_Id
|
||||
is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Bas : Entity_Id;
|
||||
-- The base type that is to be constrained by the defaults.
|
||||
|
||||
Disc : Entity_Id;
|
||||
|
||||
Bas : Entity_Id;
|
||||
-- The base type that is to be constrained by the defaults
|
||||
|
||||
begin
|
||||
if not Has_Discriminants (T) or else Is_Constrained (T) then
|
||||
return T;
|
||||
end if;
|
||||
|
||||
Bas := Base_Type (T);
|
||||
|
||||
-- If T is non-private but its base type is private, this is
|
||||
|
|
@ -757,9 +758,7 @@ package body Sem_Util is
|
|||
-- proper discriminants are to be found in the full view of
|
||||
-- the base.
|
||||
|
||||
if Is_Private_Type (Bas)
|
||||
and then Present (Full_View (Bas))
|
||||
then
|
||||
if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then
|
||||
Bas := Full_View (Bas);
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -1252,7 +1252,7 @@ package Sinfo is
|
|||
-- to the node for the spec of the instance, inserted as part of the
|
||||
-- semantic processing for instantiations in Sem_Ch12.
|
||||
|
||||
-- Is_Accessibility_Actual (Flag12-Sem)
|
||||
-- Is_Accessibility_Actual (Flag13-Sem)
|
||||
-- Present in N_Parameter_Association nodes. True if the parameter is
|
||||
-- an extra actual that carries the accessibility level of the actual
|
||||
-- for an access parameter, in a function that dispatches on result and
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue