diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2024-03-05 23:30:51 +0100 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-17 10:21:06 +0200 |
| commit | c8e5d90c4a0b736c2c4c5be3e8a3e9744e602d9d (patch) | |
| tree | 072b3b669dafe922d6b59e14990fed7195bf8fcb /gcc | |
| parent | d7dbf6c7ae69ff4d8e26b8dc7ee14104f5a9843e (diff) | |
| download | gcc-c8e5d90c4a0b736c2c4c5be3e8a3e9744e602d9d.zip gcc-c8e5d90c4a0b736c2c4c5be3e8a3e9744e602d9d.tar.gz gcc-c8e5d90c4a0b736c2c4c5be3e8a3e9744e602d9d.tar.bz2 | |
ada: Replace spinlocks with fully-fledged locks in finalization collections
This replaces spinlocks with fully-fledged locks in finalization collections
because the former are deemed problematic with tasks that can be preempted.
Because of the requirement to avoid dragging the tasking runtime when it is
not necessary, the implementation goes through the usual soft links, with an
additional hurdle that space must be reserved for the lock in any case since
it is part of the ABI. This entails the introduction of the System.OS_Locks
unit in the non-tasking runtime and the modification of the tasking runtime
to also use this unit.
This in turn requires a small adjustment: because of the presence of pre-
and post-conditions in Interfaces.C and of the limitations of the RTSfind
mechanism, the System.Finalization_Primitives unit must be preloaded, as
what is done for the Ada.Strings.Text_Buffers unit.
This effectively reverts the implementation to using the global task lock on
bare board platforms.
gcc/ada/
* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-oslock$(objext).
(LIBGNAT_TARGET_PAIRS): Use s-oslock__dummy.ads by default.
Set specific s-oslock.ads source file for all the platforms.
* exp_ch7.ads (Preload_Finalization_Collection): New procedure.
* exp_ch7.adb (Allows_Finalization_Collection): Return False if
System.Finalization_Primitives has not been preloaded.
(Preload_Finalization_Collection): New procedure.
* opt.ads (Interface_Seen): New boolean variable.
* s-oscons-tmplt.c: Use "N" string for pragma Style_Checks.
* scng.adb (Scan): Set Interface_Seen upon seeing "interface".
* sem_ch10.adb: Add clause for Exp_Ch7.
(Analyze_Compilation_Unit): Call Preload_Finalization_Collection
after the context of the unit is analyzed.
* libgnarl/a-rttiev.adb: Add with clause for System.OS_Locks and
alphabetize others.
(Event_Queue_Lock): Adjust qualified name of subtype.
* libgnarl/s-osinte__aix.ads: Add with clause for System.OS_Locks
and change pthread_mutex_t into a local subtype.
* libgnarl/s-osinte__android.ads: Likewise.
* libgnarl/s-osinte__darwin.ads: Likewise.
* libgnarl/s-osinte__dragonfly.ads: Likewise.
* libgnarl/s-osinte__freebsd.ads: Likewise.
* libgnarl/s-osinte__gnu.ads: Likewise.
* libgnarl/s-osinte__hpux-dce.ads: Likewise.
* libgnarl/s-osinte__hpux.ads: Add Likewise.
* libgnarl/s-osinte__kfreebsd-gnu.ads: Likewise.
* libgnarl/s-osinte__linux.ads: Likewise.
* libgnarl/s-osinte__lynxos178e.ads: Likewise.
* libgnarl/s-osinte__qnx.ads: Likewise.
* libgnarl/s-osinte__rtems.ads: Likewise.
* libgnarl/s-osinte__mingw.ads: Add with clause for System.OS_Locks
and change CRITICAL_SECTION into a local subtype. Add declarations
for imported procedures dealing with CRITICAL_SECTION.
* libgnarl/s-osinte__solaris.ads: Add with clause for System.OS_Locks
and change mutex_t into a local subtype.
* libgnarl/s-osinte__vxworks.ads: Add missing blank line.
* libgnarl/s-taprop.ads: Alphabetize clauses and package renamings.
Use qualified name for RTS_Lock throughout.
* libgnarl/s-taprop__dummy.adb: Add use clause for System.OS_Locks
and alphabetize others.
* libgnarl/s-taprop__hpux-dce.adb: Likewise.
* libgnarl/s-taprop__linux.adb: Likewise.
* libgnarl/s-taprop__posix.adb: Likewise.
* libgnarl/s-taprop__qnx.adb: Likewise.
* libgnarl/s-taprop__rtems.adb: Likewise.
* libgnarl/s-taprop__solaris.adb: Likewise.
* libgnarl/s-taprop__vxworks.adb: Likewise.
* libgnarl/s-taprop__mingw.adb: Likewise. Remove declarations for
imported procedures dealing with CRITICAL_SECTION.
* libgnarl/s-tarest.adb: Add with clause for System.OS_Locks and
alphabetize others.
(Global_Task_Lock): Adjust qualified name of subtype.
* libgnarl/s-tasini.adb: Add clause for System.OS_Locks.
(Initialize_RTS_Lock): New procedure.
(Finalize_RTS_Lock): Likewise.
(Acquire_RTS_Lock): Likewise.
(Release_RTS_Lock): Likewise.
(Init_RTS): Add compile-time assertions for RTS_Lock types.
Set the soft links for the RTS lock manipulation routines.
* libgnarl/s-taspri__dummy.ads: Add with clause for System.OS_Locks.
(RTS_Lock): Delete and adjust throughout accordingly.
* libgnarl/s-taspri__hpux-dce.ads: Likewise.
* libgnarl/s-taspri__lynxos.ads: Likewise.
* libgnarl/s-taspri__mingw.ads: Likewise.
* libgnarl/s-taspri__posix-noaltstack.ads: Likewise.
* libgnarl/s-taspri__posix.ads: Likewise.
* libgnarl/s-taspri__solaris.ads: Likewise.
* libgnarl/s-taspri__vxworks.ads: Likewise.
* libgnat/s-finpri.ads: Add clause for System.OS_Locks.
(Finalization_Collection): Change type of Lock.
* libgnat/s-finpri.adb (Initialize): Call Initialize_RTS_Lock.
(Lock_Collection): Call Acquire_RTS_Lock.
(Unlock_Collection): Call Release_RTS_Lock.
* libgnat/s-oslock__dummy.ads: New file.
* libgnat/s-oslock__hpux-dce.ads: Likewise.
* libgnat/s-oslock__mingw.ads: Likewise.
* libgnat/s-oslock__posix.ads: Likewise.
* libgnat/s-oslock__solaris.ads: Likewise.
* libgnat/s-oslock__vxworks.ads: Likewise.
* libgnat/s-soflin.ads (Null_Set_Address): New null procedure.
(Initialize_RTS_Lock): New soft link.
(Finalize_RTS_Lock): Likewise.
(Acquire_RTS_Lock): Likewise.
(Release_RTS_Lock): Likewise.
* exp_ch4.adb (Expand_N_Allocator): In the subtype indication case,
call Apply_Predicate_Check on the resulting access value if need be.
Diffstat (limited to 'gcc')
54 files changed, 723 insertions, 368 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 9c5bce9..570d0b2 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -652,6 +652,7 @@ GNATRTL_NONTASKING_OBJS= \ s-multip$(objext) \ s-os_lib$(objext) \ s-oscons$(objext) \ + s-oslock$(objext) \ s-osprim$(objext) \ s-pack03$(objext) \ s-pack05$(objext) \ @@ -831,6 +832,7 @@ a-intnam.ads<libgnarl/a-intnam__dummy.ads \ s-inmaop.adb<libgnarl/s-inmaop__dummy.adb \ s-intman.adb<libgnarl/s-intman__dummy.adb \ s-osinte.ads<libgnarl/s-osinte__dummy.ads \ +s-oslock.ads<libgnat/s-oslock__dummy.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__dummy.adb \ s-taspri.ads<libgnarl/s-taspri__dummy.ads @@ -1097,6 +1099,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworks7%, $(target_cpu) $(targe s-intman.adb<libgnarl/s-intman__vxworks.adb \ s-osinte.ads<libgnarl/s-osinte__vxworks.ads \ s-osinte.adb<libgnarl/s-osinte__vxworks.adb \ + s-oslock.ads<libgnat/s-oslock__vxworks.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-parame.ads<libgnat/s-parame__vxworks.ads \ s-parame.adb<libgnat/s-parame__vxworks.adb \ @@ -1198,6 +1201,7 @@ ifeq ($(strip $(filter-out %86 x86_64 wrs vxworks7%, $(target_cpu) $(target_vend s-inmaop.adb<libgnarl/s-inmaop__hwint.adb \ s-intman.ads<libgnarl/s-intman__vxworks.ads \ s-intman.adb<libgnarl/s-intman__vxworks.adb \ + s-oslock.ads<libgnat/s-oslock__vxworks.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-parame.ads<libgnat/s-parame__vxworks.ads \ s-parame.adb<libgnat/s-parame__vxworks.adb \ @@ -1306,6 +1310,7 @@ ifeq ($(strip $(filter-out aarch64 arm wrs vxworks7%, $(target_cpu) $(target_ven s-intman.adb<libgnarl/s-intman__vxworks.adb \ s-osinte.adb<libgnarl/s-osinte__vxworks.adb \ s-osinte.ads<libgnarl/s-osinte__vxworks.ads \ + s-oslock.ads<libgnat/s-oslock__vxworks.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-parame.ads<libgnat/s-parame__vxworks.ads \ s-parame.adb<libgnat/s-parame__vxworks.adb \ @@ -1386,6 +1391,7 @@ ifeq ($(strip $(filter-out arm% linux-androideabi,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__android.ads \ s-osinte.adb<libgnarl/s-osinte__android.adb \ s-osinte.ads<libgnarl/s-osinte__android.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1414,6 +1420,7 @@ ifeq ($(strip $(filter-out arm aarch64 %qnx,$(target_cpu) $(target_os))),) s-intman.adb<libgnarl/s-intman__qnx.adb \ s-osinte.adb<libgnarl/s-osinte__qnx.adb \ s-osinte.ads<libgnarl/s-osinte__qnx.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-qnx.ads<libgnarl/s-qnx.ads \ s-taprop.adb<libgnarl/s-taprop__qnx.adb \ @@ -1461,6 +1468,7 @@ ifeq ($(strip $(filter-out sparc% sun solaris%,$(target_cpu) $(target_vendor) $( s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__solaris.adb \ s-osinte.ads<libgnarl/s-osinte__solaris.ads \ + s-oslock.ads<libgnat/s-oslock__solaris.ads \ s-osprim.adb<libgnat/s-osprim__solaris.adb \ s-taprop.adb<libgnarl/s-taprop__solaris.adb \ s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \ @@ -1504,6 +1512,7 @@ ifeq ($(strip $(filter-out %86 %x86_64 solaris2%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__solaris.adb \ s-osinte.ads<libgnarl/s-osinte__solaris.ads \ + s-oslock.ads<libgnat/s-oslock__solaris.ads \ s-osprim.adb<libgnat/s-osprim__solaris.adb \ s-taprop.adb<libgnarl/s-taprop__solaris.adb \ s-tasinf.adb<libgnarl/s-tasinf__solaris.adb \ @@ -1577,6 +1586,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(target_cpu) $(target_os))),) LIBGNAT_TARGET_PAIRS += \ s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -1607,6 +1617,7 @@ ifeq ($(strip $(filter-out %86 kfreebsd%,$(target_cpu) $(target_os))),) s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__kfreebsd-gnu.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1637,6 +1648,7 @@ ifeq ($(strip $(filter-out %86 pc gnu,$(target_cpu) $(target_vendor) $(target_os s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__gnu.adb \ s-osinte.ads<libgnarl/s-osinte__gnu.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1656,6 +1668,7 @@ ifeq ($(strip $(filter-out %86 pc gnu,$(target_cpu) $(target_vendor) $(target_os LIBRARY_VERSION := $(LIB_VERSION) endif +# x86-64 kfreebsd ifeq ($(strip $(filter-out x86_64 kfreebsd%,$(target_cpu) $(target_os))),) LIBGNAT_TARGET_PAIRS = \ a-intnam.ads<libgnarl/a-intnam__freebsd.ads \ @@ -1663,6 +1676,7 @@ ifeq ($(strip $(filter-out x86_64 kfreebsd%,$(target_cpu) $(target_os))),) s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__kfreebsd-gnu.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1694,6 +1708,7 @@ ifeq ($(strip $(filter-out %aarch64 freebsd%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__freebsd.adb \ s-osinte.ads<libgnarl/s-osinte__freebsd.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1723,6 +1738,7 @@ ifeq ($(strip $(filter-out %86 freebsd%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__freebsd.adb \ s-osinte.ads<libgnarl/s-osinte__freebsd.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1753,6 +1769,7 @@ ifeq ($(strip $(filter-out %86_64 freebsd%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__freebsd.adb \ s-osinte.ads<libgnarl/s-osinte__freebsd.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1785,6 +1802,7 @@ ifeq ($(strip $(filter-out %86_64 dragonfly%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.adb<libgnarl/s-osinte__dragonfly.adb \ s-osinte.ads<libgnarl/s-osinte__dragonfly.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1816,6 +1834,7 @@ ifeq ($(strip $(filter-out s390% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -1856,6 +1875,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux10%,$(target_cpu) $(target_vendor) $(tar s-osinte.adb<libgnarl/s-osinte__hpux-dce.adb \ s-osinte.ads<libgnarl/s-osinte__hpux-dce.ads \ s-parame.ads<libgnat/s-parame__hpux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__hpux-dce.adb \ s-taspri.ads<libgnarl/s-taspri__hpux-dce.ads \ @@ -1875,6 +1895,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(target_cpu) $(target_vendor) $(tar s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__hpux.ads \ s-parame.ads<libgnat/s-parame__hpux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-traceb.adb<libgnat/s-traceb__hpux.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ @@ -1900,6 +1921,7 @@ ifeq ($(strip $(filter-out ibm aix%,$(target_vendor) $(target_os))),) s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__aix.adb \ s-osinte.ads<libgnarl/s-osinte__aix.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -1941,6 +1963,7 @@ ifeq ($(strip $(filter-out lynxos178%,$(target_os))),) s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ s-intman.adb<libgnarl/s-intman__lynxos.adb \ s-osinte.adb<libgnarl/s-osinte__lynxos178.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.ads<libgnat/s-osprim__lynxos.ads \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__lynxos.ads \ @@ -1974,6 +1997,7 @@ ifeq ($(strip $(filter-out rtems%,$(target_os))),) s-intman.ads<libgnarl/s-intman__rtems.ads \ s-osinte.adb<libgnarl/s-osinte__rtems.adb \ s-osinte.ads<libgnarl/s-osinte__rtems.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__rtems.adb \ s-parame.adb<libgnat/s-parame__rtems.adb \ s-parame.ads<libgnat/s-parame__posix2008.ads \ @@ -2075,6 +2099,7 @@ ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),) s-intman.adb<libgnarl/s-intman__mingw.adb \ s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__mingw.ads \ + s-oslock.ads<libgnat/s-oslock__mingw.ads \ s-osprim.adb<libgnat/s-osprim__mingw.adb \ s-taprop.adb<libgnarl/s-taprop__mingw.adb @@ -2135,6 +2160,7 @@ ifeq ($(strip $(filter-out loongarch% linux%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2179,6 +2205,7 @@ ifeq ($(strip $(filter-out mips% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__mips.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2226,6 +2253,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(target_cpu) $(target_os))),) s-tpopsp.adb<libgnarl/s-tpopsp__tls.adb \ s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2272,6 +2300,7 @@ ifeq ($(strip $(filter-out arm% linux-gnueabi%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2312,6 +2341,7 @@ ifeq ($(strip $(filter-out aarch64% linux%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2346,6 +2376,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__sparc.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2385,6 +2416,7 @@ ifeq ($(strip $(filter-out hppa% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__hppa.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2412,6 +2444,7 @@ ifeq ($(strip $(filter-out m68k% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2439,6 +2472,7 @@ ifeq ($(strip $(filter-out sh4% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2474,6 +2508,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2509,6 +2544,7 @@ ifeq ($(strip $(filter-out ia64% hp hpux%,$(target_cpu) $(target_vendor) $(targe s-intman.adb<libgnarl/s-intman__posix.adb \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__hpux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ @@ -2542,6 +2578,7 @@ ifeq ($(strip $(filter-out alpha% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__alpha.ads \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2578,6 +2615,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2622,6 +2660,7 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),) s-mudido.adb<libgnarl/s-mudido__affinity.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ s-osinte.adb<libgnarl/s-osinte__x32.adb \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__x32.adb \ s-parame.ads<libgnat/s-parame__posix2008.ads \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ @@ -2661,6 +2700,7 @@ ifeq ($(strip $(filter-out riscv% linux%,$(target_cpu) $(target_os))),) s-linux.ads<libgnarl/s-linux__riscv.ads \ s-osinte.adb<libgnarl/s-osinte__posix.adb \ s-osinte.ads<libgnarl/s-osinte__linux.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-osprim.adb<libgnat/s-osprim__posix.adb \ s-taprop.adb<libgnarl/s-taprop__linux.adb \ s-tasinf.ads<libgnarl/s-tasinf__linux.ads \ @@ -2699,6 +2739,7 @@ ifeq ($(strip $(filter-out darwin%,$(target_os))),) s-inmaop.adb<libgnarl/s-inmaop__posix.adb \ s-osinte.adb<libgnarl/s-osinte__darwin.adb \ s-osinte.ads<libgnarl/s-osinte__darwin.ads \ + s-oslock.ads<libgnat/s-oslock__posix.ads \ s-taprop.adb<libgnarl/s-taprop__posix.adb \ s-taspri.ads<libgnarl/s-taspri__posix.ads \ g-sercom.adb<libgnat/g-sercom__linux.adb \ diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 42d18f7..29249eb 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4694,6 +4694,8 @@ package body Exp_Ch4 is Build_Allocate_Deallocate_Proc (Temp_Decl); Rewrite (N, New_Occurrence_Of (Temp, Loc)); Analyze_And_Resolve (N, PtrT); + + Apply_Predicate_Check (N, Dtyp, Deref => True); end; -- Or else build the fully-fledged initialization if need be diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 993c13c..fdacf1c 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -965,6 +965,12 @@ package body Exp_Ch7 is if Restriction_Active (No_Finalization) then return False; + -- The System.Finalization_Primitives unit must have been preloaded if + -- finalization is really required. + + elsif not RTU_Loaded (System_Finalization_Primitives) then + return False; + -- Do not consider C and C++ types since it is assumed that the non-Ada -- side will handle their cleanup. @@ -8624,6 +8630,38 @@ package body Exp_Ch7 is return Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped; end Node_To_Be_Wrapped; + -------------------------------------- + -- Preload_Finalization_Collection -- + -------------------------------------- + + procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id) is + begin + -- We can't call RTE (Finalization_Collection) for at least some + -- predefined units, because it would introduce cyclic dependences, + -- as the type is itself a controlled type. + -- + -- It's only needed when finalization is involved in the unit, which + -- requires the presence of controlled or class-wide types in the unit + -- (see the Sem_Util.Needs_Finalization predicate for the rationale). + -- But controlled types are tagged or contain tagged (sub)components + -- so it is sufficient for the parser to detect the "interface" and + -- "tagged" keywords. + -- + -- Don't do it if Finalization_Collection is unavailable in the runtime + + if not In_Predefined_Unit (Compilation_Unit) + and then (Interface_Seen or else Tagged_Seen) + and then not No_Run_Time_Mode + and then RTE_Available (RE_Finalization_Collection) + then + declare + Ignore : constant Entity_Id := RTE (RE_Finalization_Collection); + begin + null; + end; + end if; + end Preload_Finalization_Collection; + ---------------------------- -- Store_Actions_In_Scope -- ---------------------------- diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 712671a..386a02b 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -257,6 +257,12 @@ package Exp_Ch7 is -- Build a call to suppress the finalization of the object Obj, only after -- creating the Master_Node of Obj if it does not already exist. + procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id); + -- Call RTE (RE_Finalization_Collection) if necessary to load the packages + -- involved in finalization support. We need to do this explicitly, fairly + -- early during compilation, because otherwise it happens during freezing, + -- which triggers visibility bugs in generic instantiations. + -------------------------------------------- -- Task and Protected Object finalization -- -------------------------------------------- diff --git a/gcc/ada/libgnarl/a-rttiev.adb b/gcc/ada/libgnarl/a-rttiev.adb index 93bba77..6d0664a 100644 --- a/gcc/ada/libgnarl/a-rttiev.adb +++ b/gcc/ada/libgnarl/a-rttiev.adb @@ -29,10 +29,11 @@ -- -- ------------------------------------------------------------------------------ +with System.Interrupt_Management.Operations; +with System.OS_Locks; +with System.Soft_Links; with System.Task_Primitives.Operations; with System.Tasking.Utilities; -with System.Soft_Links; -with System.Interrupt_Management.Operations; with Ada.Containers.Doubly_Linked_Lists; pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists); @@ -61,7 +62,7 @@ package body Ada.Real_Time.Timing_Events is -- The queue of pending events, ordered by increasing timeout value, that -- have been "set" by the user via Set_Handler. - Event_Queue_Lock : aliased System.Task_Primitives.RTS_Lock; + Event_Queue_Lock : aliased System.OS_Locks.RTS_Lock; -- Used for mutually exclusive access to All_Events -- We need to Initialize_Lock before Timer is activated. The purpose of the diff --git a/gcc/ada/libgnarl/s-osinte__aix.ads b/gcc/ada/libgnarl/s-osinte__aix.ads index 9212d33..ba61be1 100644 --- a/gcc/ada/libgnarl/s-osinte__aix.ads +++ b/gcc/ada/libgnarl/s-osinte__aix.ads @@ -43,6 +43,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; with Interfaces.C.Extensions; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -271,7 +272,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -575,21 +576,6 @@ private ptq_prev : ptq_queue_ptr; end record; - type Array_3_Int is array (0 .. 3) of int; - type pthread_mutex_t is record - link : ptq_queue; - ptmtx_lock : int; - ptmtx_flags : long; - protocol : int; - prioceiling : int; - ptmtx_owner : pthread_t; - mtx_id : int; - attr : pthread_attr_t; - mtx_kind : int; - lock_cpt : int; - reserved : Array_3_Int; - end record; - pragma Convention (C, pthread_mutex_t); type pthread_mutex_t_ptr is access pthread_mutex_t; type pthread_cond_t is record diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads index ca35aab..8e1b5a2 100644 --- a/gcc/ada/libgnarl/s-osinte__android.ads +++ b/gcc/ada/libgnarl/s-osinte__android.ads @@ -39,9 +39,12 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Ada.Unchecked_Conversion; + with Interfaces.C; + with System.Linux; with System.OS_Constants; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -271,7 +274,7 @@ package System.OS_Interface is function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -626,12 +629,6 @@ private pragma Convention (C, pthread_mutexattr_t); for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment; - type pthread_mutex_t is record - Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); - end record; - pragma Convention (C, pthread_mutex_t); - for pthread_mutex_t'Alignment use Interfaces.C.unsigned_long'Alignment; - type pthread_cond_t is record Data : char_array (1 .. OS_Constants.PTHREAD_COND_SIZE); end record; diff --git a/gcc/ada/libgnarl/s-osinte__darwin.ads b/gcc/ada/libgnarl/s-osinte__darwin.ads index af5dce5..0ffa18b 100644 --- a/gcc/ada/libgnarl/s-osinte__darwin.ads +++ b/gcc/ada/libgnarl/s-osinte__darwin.ads @@ -39,7 +39,9 @@ -- Elaborate_Body. It is designed to be a bottom-level (leaf) package. with Interfaces.C; + with System.OS_Constants; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -244,7 +246,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -571,12 +573,6 @@ private end record; pragma Convention (C, pthread_mutexattr_t); - type pthread_mutex_t is record - sig : long; - opaque : padding (1 .. System.OS_Constants.PTHREAD_MUTEX_SIZE); - end record; - pragma Convention (C, pthread_mutex_t); - type pthread_condattr_t is record sig : long; opaque : padding (1 .. System.OS_Constants.PTHREAD_CONDATTR_SIZE); diff --git a/gcc/ada/libgnarl/s-osinte__dragonfly.ads b/gcc/ada/libgnarl/s-osinte__dragonfly.ads index bf078dd..e34c7fb 100644 --- a/gcc/ada/libgnarl/s-osinte__dragonfly.ads +++ b/gcc/ada/libgnarl/s-osinte__dragonfly.ads @@ -43,6 +43,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -278,7 +279,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -646,7 +647,6 @@ private type pthread_t is new System.Address; type pthread_attr_t is new System.Address; - type pthread_mutex_t is new System.Address; type pthread_mutexattr_t is new System.Address; type pthread_cond_t is new System.Address; type pthread_condattr_t is new System.Address; diff --git a/gcc/ada/libgnarl/s-osinte__freebsd.ads b/gcc/ada/libgnarl/s-osinte__freebsd.ads index 8724ddc..bda06b9 100644 --- a/gcc/ada/libgnarl/s-osinte__freebsd.ads +++ b/gcc/ada/libgnarl/s-osinte__freebsd.ads @@ -43,6 +43,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -280,7 +281,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -643,7 +644,6 @@ private type pthread_t is new System.Address; type pthread_attr_t is new System.Address; - type pthread_mutex_t is new System.Address; type pthread_mutexattr_t is new System.Address; type pthread_cond_t is new System.Address; type pthread_condattr_t is new System.Address; diff --git a/gcc/ada/libgnarl/s-osinte__gnu.ads b/gcc/ada/libgnarl/s-osinte__gnu.ads index 8e5760d..62645b6 100644 --- a/gcc/ada/libgnarl/s-osinte__gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__gnu.ads @@ -38,9 +38,12 @@ -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package +with Ada.Unchecked_Conversion; + with Interfaces.C; + +with System.OS_Locks; with System.Parameters; -with Ada.Unchecked_Conversion; package System.OS_Interface is pragma Preelaborate; @@ -298,14 +301,14 @@ package System.OS_Interface is function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_rwlock_t is limited private; - type pthread_cond_t is limited private; - type pthread_attr_t is limited private; - type pthread_mutexattr_t is limited private; + type pthread_cond_t is limited private; + type pthread_attr_t is limited private; + type pthread_mutexattr_t is limited private; type pthread_rwlockattr_t is limited private; - type pthread_condattr_t is limited private; - type pthread_key_t is private; + type pthread_condattr_t is limited private; + type pthread_key_t is private; -- From /usr/include/pthread/pthreadtypes.h PTHREAD_CREATE_DETACHED : constant := 1; @@ -712,39 +715,6 @@ private end record; pragma Convention (C, pthread_mutexattr_t); - -- From: /usr/include/pthread/pthreadtypes.h - -- typedef struct __pthread_mutex pthread_mutex_t; and - -- /usr/include/i386-gnu/bits/mutex.h: - -- struct __pthread_mutex { - -- __pthread_spinlock_t __held; - -- __pthread_spinlock_t __lock; - -- /* in cthreads, mutex_init does not initialized the third - -- pointer, as such, we cannot rely on its value for anything. */ - -- char *cthreadscompat1; - -- struct __pthread *__queue; - -- struct __pthread_mutexattr *attr; - -- void *data; - -- /* up to this point, we are completely compatible with cthreads - -- and what libc expects. */ - -- void *owner; - -- unsigned locks; - -- /* if null then the default attributes apply. */ - -- }; - - type pthread_mutex_t is record - held : int; - lock : int; - cthreadcompat : System.Address; - queue : System.Address; - attr : System.Address; - data : System.Address; - owner : System.Address; - locks : unsigned; - end record; - pragma Convention (C, pthread_mutex_t); - -- pointer needed? - -- type pthread_mutex_t_ptr is access pthread_mutex_t; - -- From: /usr/include/pthread/pthreadtypes.h: -- typedef struct __pthread_cond pthread_cond_t; -- typedef struct __pthread_condattr pthread_condattr_t; diff --git a/gcc/ada/libgnarl/s-osinte__hpux-dce.ads b/gcc/ada/libgnarl/s-osinte__hpux-dce.ads index b1ccd96..364a5ec 100644 --- a/gcc/ada/libgnarl/s-osinte__hpux-dce.ads +++ b/gcc/ada/libgnarl/s-osinte__hpux-dce.ads @@ -42,6 +42,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -239,7 +240,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -478,9 +479,6 @@ private type pthread_t is new cma_t_handle; pragma Convention (C_Pass_By_Copy, pthread_t); - type pthread_mutex_t is new cma_t_handle; - pragma Convention (C_Pass_By_Copy, pthread_mutex_t); - type pthread_cond_t is new cma_t_handle; pragma Convention (C_Pass_By_Copy, pthread_cond_t); diff --git a/gcc/ada/libgnarl/s-osinte__hpux.ads b/gcc/ada/libgnarl/s-osinte__hpux.ads index 52d5995..5d3d352 100644 --- a/gcc/ada/libgnarl/s-osinte__hpux.ads +++ b/gcc/ada/libgnarl/s-osinte__hpux.ads @@ -42,6 +42,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -252,7 +253,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -533,26 +534,6 @@ private type short_array is array (Natural range <>) of short; type int_array is array (Natural range <>) of int; - type pthread_mutex_t is record - m_short : short_array (0 .. 1); - m_int : int; - m_int1 : int_array (0 .. 3); - m_pad : int; - - m_ptr : int; - -- actually m_ptr is a void*, and on 32 bit ABI, m_pad is added so that - -- this field takes 64 bits. On 64 bit ABI, m_pad is gone, and m_ptr is - -- a 64 bit void*. Assume int'Size = 32. - - m_int2 : int_array (0 .. 1); - m_int3 : int_array (0 .. 3); - m_short2 : short_array (0 .. 1); - m_int4 : int_array (0 .. 4); - m_int5 : int_array (0 .. 1); - end record; - for pthread_mutex_t'Alignment use System.Address'Alignment; - pragma Convention (C, pthread_mutex_t); - type pthread_cond_t is record c_short : short_array (0 .. 1); c_int : int; diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads index 9383759..5725a11 100644 --- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads @@ -39,7 +39,10 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package with Ada.Unchecked_Conversion; + with Interfaces.C; + +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -284,7 +287,7 @@ package System.OS_Interface is function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -637,15 +640,6 @@ private end record; pragma Convention (C, struct_pthread_fast_lock); - type pthread_mutex_t is record - m_reserved : int; - m_count : int; - m_owner : System.Address; - m_kind : int; - m_lock : struct_pthread_fast_lock; - end record; - pragma Convention (C, pthread_mutex_t); - type pthread_cond_t is array (0 .. 47) of unsigned_char; pragma Convention (C, pthread_cond_t); diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads index 1bf4d96..71788be 100644 --- a/gcc/ada/libgnarl/s-osinte__linux.ads +++ b/gcc/ada/libgnarl/s-osinte__linux.ads @@ -39,9 +39,12 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Ada.Unchecked_Conversion; + with Interfaces.C; + with System.Linux; with System.OS_Constants; +with System.OS_Locks; package System.OS_Interface is pragma Preelaborate; @@ -301,7 +304,7 @@ package System.OS_Interface is function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_rwlock_t is limited private; type pthread_cond_t is limited private; type pthread_attr_t is limited private; @@ -656,12 +659,6 @@ private pragma Convention (C, pthread_mutexattr_t); for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment; - type pthread_mutex_t is record - Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); - end record; - pragma Convention (C, pthread_mutex_t); - for pthread_mutex_t'Alignment use Interfaces.C.unsigned_long'Alignment; - type pthread_rwlockattr_t is record Data : char_array (1 .. OS_Constants.PTHREAD_RWLOCKATTR_SIZE); end record; diff --git a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads index 23ea89a..d9f2f12 100644 --- a/gcc/ada/libgnarl/s-osinte__lynxos178e.ads +++ b/gcc/ada/libgnarl/s-osinte__lynxos178e.ads @@ -43,6 +43,7 @@ with Ada.Unchecked_Conversion; with Interfaces.C; with System.Multiprocessors; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -267,7 +268,7 @@ package System.OS_Interface is subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -597,18 +598,6 @@ private end record; pragma Convention (C, block_obj_t); - type pthread_mutex_t is record - m_flags : unsigned; - m_owner : tid_t; - m_wait : block_obj_t; - m_prio_c : int; - m_oldprio : int; - m_count : int; - m_referenced : int; - end record; - pragma Convention (C, pthread_mutex_t); - type pthread_mutex_t_ptr is access all pthread_mutex_t; - type pthread_cond_t is record cv_magic : unsigned; cv_wait : block_obj_t; diff --git a/gcc/ada/libgnarl/s-osinte__mingw.ads b/gcc/ada/libgnarl/s-osinte__mingw.ads index 4be6c03..575eb35 100644 --- a/gcc/ada/libgnarl/s-osinte__mingw.ads +++ b/gcc/ada/libgnarl/s-osinte__mingw.ads @@ -43,6 +43,8 @@ with Ada.Unchecked_Conversion; with Interfaces.C; with Interfaces.C.Strings; + +with System.OS_Locks; with System.Win32; package System.OS_Interface is @@ -144,7 +146,24 @@ package System.OS_Interface is -- Critical sections -- ----------------------- - type CRITICAL_SECTION is private; + subtype CRITICAL_SECTION is System.OS_Locks.CRITICAL_SECTION; + + procedure InitializeCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import + (Stdcall, InitializeCriticalSection, "InitializeCriticalSection"); + + procedure EnterCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection"); + + procedure LeaveCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection"); + + procedure DeleteCriticalSection + (pCriticalSection : access CRITICAL_SECTION); + pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection"); ------------------------------------------------------------- -- Thread Creation, Activation, Suspension And Termination -- @@ -359,17 +378,4 @@ private type sigset_t is new Interfaces.C.unsigned_long; - type CRITICAL_SECTION is record - DebugInfo : System.Address; - - LockCount : Long_Integer; - RecursionCount : Long_Integer; - OwningThread : Win32.HANDLE; - -- The above three fields control entering and exiting the critical - -- section for the resource. - - LockSemaphore : Win32.HANDLE; - SpinCount : Interfaces.C.size_t; - end record; - end System.OS_Interface; diff --git a/gcc/ada/libgnarl/s-osinte__qnx.ads b/gcc/ada/libgnarl/s-osinte__qnx.ads index b1de1c6..91b1d18 100644 --- a/gcc/ada/libgnarl/s-osinte__qnx.ads +++ b/gcc/ada/libgnarl/s-osinte__qnx.ads @@ -38,8 +38,11 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Ada.Unchecked_Conversion; + with Interfaces.C; + with System.OS_Constants; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -268,7 +271,7 @@ package System.OS_Interface is type pthread_t is new int; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_cond_t is limited private; type pthread_attr_t is limited private; type pthread_mutexattr_t is limited private; @@ -283,7 +286,7 @@ package System.OS_Interface is PTHREAD_INHERIT_SCHED : constant := 0; PTHREAD_EXPLICIT_SCHED : constant := 2; - -- Read/Write lock not supported on Android. + -- Read/Write lock not supported on QNX subtype pthread_rwlock_t is pthread_mutex_t; subtype pthread_rwlockattr_t is pthread_mutexattr_t; @@ -601,12 +604,6 @@ private pragma Convention (C, pthread_mutexattr_t); for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment; - type pthread_mutex_t is record - Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); - end record; - pragma Convention (C, pthread_mutex_t); - for pthread_mutex_t'Alignment use Interfaces.C.unsigned_long'Alignment; - type pthread_cond_t is record Data : char_array (1 .. OS_Constants.PTHREAD_COND_SIZE); end record; diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads b/gcc/ada/libgnarl/s-osinte__rtems.ads index 6a7487c..de7174c 100644 --- a/gcc/ada/libgnarl/s-osinte__rtems.ads +++ b/gcc/ada/libgnarl/s-osinte__rtems.ads @@ -51,7 +51,9 @@ -- It is designed to be a bottom-level (leaf) package. with Interfaces.C; + with System.OS_Constants; +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -247,7 +249,7 @@ package System.OS_Interface is type pthread_t is private; subtype Thread_Id is pthread_t; - type pthread_mutex_t is limited private; + subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t; type pthread_rwlock_t is limited private; type pthread_cond_t is limited private; type pthread_attr_t is limited private; @@ -629,12 +631,6 @@ private type pthread_t is new rtems_id; - type pthread_mutex_t is record - Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); - end record; - pragma Convention (C, pthread_mutex_t); - for pthread_mutex_t'Alignment use Interfaces.C.double'Alignment; - type pthread_rwlock_t is record Data : char_array (1 .. OS_Constants.PTHREAD_RWLOCK_SIZE); end record; diff --git a/gcc/ada/libgnarl/s-osinte__solaris.ads b/gcc/ada/libgnarl/s-osinte__solaris.ads index a7ee96d..12ad52b 100644 --- a/gcc/ada/libgnarl/s-osinte__solaris.ads +++ b/gcc/ada/libgnarl/s-osinte__solaris.ads @@ -38,10 +38,11 @@ -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package. -with Interfaces.C; - with Ada.Unchecked_Conversion; +with Interfaces.C; + +with System.OS_Locks; with System.Parameters; package System.OS_Interface is @@ -297,7 +298,7 @@ package System.OS_Interface is function To_thread_t is new Ada.Unchecked_Conversion (Integer, thread_t); - type mutex_t is limited private; + subtype mutex_t is System.OS_Lock.mutex_t; type cond_t is limited private; @@ -543,13 +544,6 @@ private type upad64_t is new Interfaces.Unsigned_64; - type mutex_t is record - flags : record_type_3; - lock : upad64_t; - data : upad64_t; - end record; - pragma Convention (C, mutex_t); - type cond_t is record flags : record_type_3; data : upad64_t; diff --git a/gcc/ada/libgnarl/s-osinte__vxworks.ads b/gcc/ada/libgnarl/s-osinte__vxworks.ads index 5e4e8ce..00e9e2d 100644 --- a/gcc/ada/libgnarl/s-osinte__vxworks.ads +++ b/gcc/ada/libgnarl/s-osinte__vxworks.ads @@ -39,6 +39,7 @@ -- Preelaborate. This package is designed to be a bottom-level (leaf) package. with Interfaces.C; + with System.VxWorks; with System.VxWorks.Ext; with System.Multiprocessors; diff --git a/gcc/ada/libgnarl/s-taprop.ads b/gcc/ada/libgnarl/s-taprop.ads index c4920e3..35f0ea4 100644 --- a/gcc/ada/libgnarl/s-taprop.ads +++ b/gcc/ada/libgnarl/s-taprop.ads @@ -32,15 +32,15 @@ -- This package contains all the GNULL primitives that interface directly with -- the underlying OS. +with System.OS_Interface; with System.Parameters; with System.Tasking; -with System.OS_Interface; package System.Task_Primitives.Operations is pragma Preelaborate; - package ST renames System.Tasking; package OSI renames System.OS_Interface; + package ST renames System.Tasking; procedure Initialize (Environment_Task : ST.Task_Id); -- Perform initialization and set up of the environment task for proper @@ -149,7 +149,7 @@ package System.Task_Primitives.Operations is (Prio : System.Any_Priority; L : not null access Lock); procedure Initialize_Lock - (L : not null access RTS_Lock; + (L : not null access System.OS_Locks.RTS_Lock; Level : Lock_Level); pragma Inline (Initialize_Lock); -- Initialize a lock object @@ -173,7 +173,7 @@ package System.Task_Primitives.Operations is -- These operations raise Storage_Error if a lack of storage is detected procedure Finalize_Lock (L : not null access Lock); - procedure Finalize_Lock (L : not null access RTS_Lock); + procedure Finalize_Lock (L : not null access System.OS_Locks.RTS_Lock); pragma Inline (Finalize_Lock); -- Finalize a lock object, freeing any resources allocated by the -- corresponding Initialize_Lock operation. @@ -181,7 +181,7 @@ package System.Task_Primitives.Operations is procedure Write_Lock (L : not null access Lock; Ceiling_Violation : out Boolean); - procedure Write_Lock (L : not null access RTS_Lock); + procedure Write_Lock (L : not null access System.OS_Locks.RTS_Lock); procedure Write_Lock (T : ST.Task_Id); pragma Inline (Write_Lock); -- Lock a lock object for write access. After this operation returns, @@ -229,7 +229,7 @@ package System.Task_Primitives.Operations is procedure Unlock (L : not null access Lock); - procedure Unlock (L : not null access RTS_Lock); + procedure Unlock (L : not null access System.OS_Locks.RTS_Lock); procedure Unlock (T : ST.Task_Id); pragma Inline (Unlock); -- Unlock a locked lock object diff --git a/gcc/ada/libgnarl/s-taprop__dummy.adb b/gcc/ada/libgnarl/s-taprop__dummy.adb index 829d595..68ec8b4 100644 --- a/gcc/ada/libgnarl/s-taprop__dummy.adb +++ b/gcc/ada/libgnarl/s-taprop__dummy.adb @@ -36,8 +36,9 @@ package body System.Task_Primitives.Operations is - use System.Tasking; + use System.OS_Locks; use System.Parameters; + use System.Tasking; pragma Warnings (Off); -- Turn off warnings since so many unreferenced parameters diff --git a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb index fb95f76..7f4e707 100644 --- a/gcc/ada/libgnarl/s-taprop__hpux-dce.adb +++ b/gcc/ada/libgnarl/s-taprop__hpux-dce.adb @@ -38,11 +38,11 @@ with Ada.Unchecked_Conversion; with Interfaces.C; -with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Constants; with System.OS_Primitives; with System.Task_Primitives.Interrupt_Operations; +with System.Tasking.Debug; pragma Warnings (Off); with System.Interrupt_Management.Operations; @@ -60,12 +60,14 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use Interfaces.C; + use System.OS_Interface; - use System.Parameters; + use System.OS_Locks; use System.OS_Primitives; + use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; package PIO renames System.Task_Primitives.Interrupt_Operations; diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 74717cb..1faa3d8 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -34,14 +34,14 @@ -- This package contains all the GNULL primitives that interface directly with -- the underlying OS. -with Interfaces.C; use Interfaces; use type Interfaces.C.int; +with Interfaces.C; -with System.Task_Info; -with System.Tasking.Debug; with System.Interrupt_Management; +with System.Multiprocessors; with System.OS_Constants; with System.OS_Primitives; -with System.Multiprocessors; +with System.Task_Info; +with System.Tasking.Debug; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -54,12 +54,17 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; - use System.OS_Interface; + use Interfaces; + use System.Parameters; + use System.OS_Interface; + use System.OS_Locks; use System.OS_Primitives; use System.Task_Info; + use System.Tasking.Debug; + use System.Tasking; + + use type Interfaces.C.int; ---------------- -- Local Data -- diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index e97682e..df1cb67 100644 --- a/gcc/ada/libgnarl/s-taprop__mingw.adb +++ b/gcc/ada/libgnarl/s-taprop__mingw.adb @@ -57,7 +57,9 @@ package body System.Task_Primitives.Operations is use Interfaces.C; use Interfaces.C.Strings; + use System.OS_Interface; + use System.OS_Locks; use System.OS_Primitives; use System.Parameters; use System.Task_Info; @@ -73,30 +75,6 @@ package body System.Task_Primitives.Operations is -- Also note that under Windows XP, we use a Windows XP extension to -- specify the stack size on a per task basis, as done under other OSes. - --------------------- - -- Local Functions -- - --------------------- - - procedure InitializeCriticalSection (pCriticalSection : access RTS_Lock); - procedure InitializeCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import - (Stdcall, InitializeCriticalSection, "InitializeCriticalSection"); - - procedure EnterCriticalSection (pCriticalSection : access RTS_Lock); - procedure EnterCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection"); - - procedure LeaveCriticalSection (pCriticalSection : access RTS_Lock); - procedure LeaveCriticalSection (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection"); - - procedure DeleteCriticalSection (pCriticalSection : access RTS_Lock); - procedure DeleteCriticalSection - (pCriticalSection : access CRITICAL_SECTION); - pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection"); - ---------------- -- Local Data -- ---------------- @@ -421,7 +399,8 @@ package body System.Task_Primitives.Operations is end Initialize_Lock; procedure Initialize_Lock - (L : not null access RTS_Lock; Level : Lock_Level) + (L : not null access RTS_Lock; + Level : Lock_Level) is pragma Unreferenced (Level); begin diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb index a71e421..7ed52ea 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -44,11 +44,11 @@ with Ada.Unchecked_Conversion; with Interfaces.C; -with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Constants; with System.OS_Primitives; with System.Task_Info; +with System.Tasking.Debug; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -61,12 +61,14 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use Interfaces.C; + use System.OS_Interface; - use System.Parameters; + use System.OS_Locks; use System.OS_Primitives; + use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; ---------------- -- Local Data -- diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb index 2f11d28..108180d 100644 --- a/gcc/ada/libgnarl/s-taprop__qnx.adb +++ b/gcc/ada/libgnarl/s-taprop__qnx.adb @@ -44,12 +44,12 @@ with Ada.Unchecked_Conversion; with Interfaces.C; -with System.Tasking.Debug; with System.Interrupt_Management; +with System.Multiprocessors; with System.OS_Constants; with System.OS_Primitives; with System.Task_Info; -with System.Multiprocessors; +with System.Tasking.Debug; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -62,12 +62,14 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use Interfaces.C; + use System.OS_Interface; - use System.Parameters; + use System.OS_Locks; use System.OS_Primitives; + use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; ---------------- -- Local Data -- diff --git a/gcc/ada/libgnarl/s-taprop__rtems.adb b/gcc/ada/libgnarl/s-taprop__rtems.adb index b041592..3feafd8 100644 --- a/gcc/ada/libgnarl/s-taprop__rtems.adb +++ b/gcc/ada/libgnarl/s-taprop__rtems.adb @@ -38,11 +38,11 @@ with Ada.Unchecked_Conversion; with Interfaces.C; -with System.Tasking.Debug; with System.Interrupt_Management; with System.OS_Constants; with System.OS_Primitives; with System.Task_Info; +with System.Tasking.Debug; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -55,12 +55,14 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use Interfaces.C; + use System.OS_Interface; - use System.Parameters; + use System.OS_Locks; use System.OS_Primitives; + use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; ---------------- -- Local Data -- diff --git a/gcc/ada/libgnarl/s-taprop__solaris.adb b/gcc/ada/libgnarl/s-taprop__solaris.adb index 657ad55..88b77b0 100644 --- a/gcc/ada/libgnarl/s-taprop__solaris.adb +++ b/gcc/ada/libgnarl/s-taprop__solaris.adb @@ -36,12 +36,12 @@ with Interfaces.C; -with System.Multiprocessors; -with System.Tasking.Debug; with System.Interrupt_Management; +with System.Multiprocessors; with System.OS_Constants; with System.OS_Primitives; with System.Task_Info; +with System.Tasking.Debug; pragma Warnings (Off); with System.OS_Lib; @@ -58,12 +58,14 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use Interfaces.C; + use System.OS_Interface; - use System.Parameters; + use System.OS_Locks; use System.OS_Primitives; + use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; ---------------- -- Local Data -- diff --git a/gcc/ada/libgnarl/s-taprop__vxworks.adb b/gcc/ada/libgnarl/s-taprop__vxworks.adb index 8b146f9..feafab4 100644 --- a/gcc/ada/libgnarl/s-taprop__vxworks.adb +++ b/gcc/ada/libgnarl/s-taprop__vxworks.adb @@ -38,11 +38,11 @@ with Ada.Unchecked_Conversion; with Interfaces.C; -with System.Multiprocessors; -with System.Tasking.Debug; -with System.Interrupt_Management; with System.Float_Control; +with System.Interrupt_Management; +with System.Multiprocessors; with System.OS_Constants; +with System.Tasking.Debug; with System.Soft_Links; -- We use System.Soft_Links instead of System.Tasking.Initialization @@ -58,10 +58,12 @@ package body System.Task_Primitives.Operations is package OSC renames System.OS_Constants; package SSL renames System.Soft_Links; - use System.Tasking.Debug; - use System.Tasking; use System.OS_Interface; + use System.OS_Locks; use System.Parameters; + use System.Tasking; + use System.Tasking.Debug; + use type Interfaces.C.int; use type System.OS_Interface.unsigned; use type System.VxWorks.Ext.t_id; diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb index 98ceb8f..5c2ee90 100644 --- a/gcc/ada/libgnarl/s-tarest.adb +++ b/gcc/ada/libgnarl/s-tarest.adb @@ -41,8 +41,9 @@ pragma Style_Checks (All_Checks); with Ada.Exceptions; -with System.Task_Primitives.Operations; +with System.OS_Locks; with System.Soft_Links.Tasking; +with System.Task_Primitives.Operations; with System.Soft_Links; -- Used for the non-tasking routines (*_NT) that refer to global data. They @@ -63,7 +64,7 @@ package body System.Tasking.Restricted.Stages is Tasks_Activation_Chain : Task_Id; -- Chain of all the tasks to activate - Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock; + Global_Task_Lock : aliased System.OS_Locks.RTS_Lock; -- This is a global lock; it is used to execute in mutual exclusion -- from all other tasks. It is only used by Task_Lock and Task_Unlock. diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb index 8bb42d9..2229414 100644 --- a/gcc/ada/libgnarl/s-tasini.adb +++ b/gcc/ada/libgnarl/s-tasini.adb @@ -33,10 +33,11 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram alpha ordering check, since we group soft link bodies -- and dummy soft link bodies together separately in this unit. -with System.Task_Primitives; -with System.Task_Primitives.Operations; +with System.OS_Locks; with System.Soft_Links; with System.Soft_Links.Tasking; +with System.Task_Primitives; +with System.Task_Primitives.Operations; with System.Tasking.Debug; with System.Tasking.Task_Attributes; @@ -48,13 +49,14 @@ pragma Unreferenced (System.Secondary_Stack); package body System.Tasking.Initialization is - package STPO renames System.Task_Primitives.Operations; + package SOL renames System.OS_Locks; package SSL renames System.Soft_Links; + package STPO renames System.Task_Primitives.Operations; use Parameters; use Task_Primitives.Operations; - Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock; + Global_Task_Lock : aliased SOL.RTS_Lock; -- This is a global lock; it is used to execute in mutual exclusion from -- all other tasks. It is only used by Task_Lock, Task_Unlock, and -- Final_Task_Unlock. @@ -88,6 +90,18 @@ package body System.Tasking.Initialization is function Task_Name return String; -- Returns current task's name + procedure Initialize_RTS_Lock (Addr : Address); + -- Initialize the RTS lock at Addr + + procedure Finalize_RTS_Lock (Addr : Address); + -- Finalize the RTS lock at Addr + + procedure Acquire_RTS_Lock (Addr : Address); + -- Acquire the RTS lock at Addr + + procedure Release_RTS_Lock (Addr : Address); + -- Release the RTS lock at Addr + ------------------------ -- Local Subprograms -- ------------------------ @@ -220,6 +234,54 @@ package body System.Tasking.Initialization is return STPO.Self.Common.Compiler_Data.Current_Excep'Access; end Get_Current_Excep; + ------------------------- + -- Initialize_RTS_Lock -- + ------------------------- + + procedure Initialize_RTS_Lock (Addr : Address) is + Lock : aliased SOL.RTS_Lock; + for Lock'Address use Addr; + + begin + Initialize_Lock (Lock'Unchecked_Access, PO_Level); + end Initialize_RTS_Lock; + + ----------------------- + -- Finalize_RTS_Lock -- + ----------------------- + + procedure Finalize_RTS_Lock (Addr : Address) is + Lock : aliased SOL.RTS_Lock; + for Lock'Address use Addr; + + begin + Finalize_Lock (Lock'Unchecked_Access); + end Finalize_RTS_Lock; + + ---------------------- + -- Acquire_RTS_Lock -- + ---------------------- + + procedure Acquire_RTS_Lock (Addr : Address) is + Lock : aliased SOL.RTS_Lock; + for Lock'Address use Addr; + + begin + Write_Lock (Lock'Unchecked_Access); + end Acquire_RTS_Lock; + + ---------------------- + -- Release_RTS_Lock -- + ---------------------- + + procedure Release_RTS_Lock (Addr : Address) is + Lock : aliased SOL.RTS_Lock; + for Lock'Address use Addr; + + begin + Unlock (Lock'Unchecked_Access); + end Release_RTS_Lock; + ----------------------- -- Do_Pending_Action -- ----------------------- @@ -352,6 +414,11 @@ package body System.Tasking.Initialization is SSL.Task_Name := Task_Name'Access; SSL.Get_Current_Excep := Get_Current_Excep'Access; + SSL.Initialize_RTS_Lock := Initialize_RTS_Lock'Access; + SSL.Finalize_RTS_Lock := Finalize_RTS_Lock'Access; + SSL.Acquire_RTS_Lock := Acquire_RTS_Lock'Access; + SSL.Release_RTS_Lock := Release_RTS_Lock'Access; + -- Initialize the tasking soft links (if not done yet) that are common -- to the full and the restricted run times. diff --git a/gcc/ada/libgnarl/s-taspri__dummy.ads b/gcc/ada/libgnarl/s-taspri__dummy.ads index 4b25f19..58a250d 100644 --- a/gcc/ada/libgnarl/s-taspri__dummy.ads +++ b/gcc/ada/libgnarl/s-taspri__dummy.ads @@ -31,13 +31,13 @@ -- This is a no tasking version of this package +with System.OS_Locks; + package System.Task_Primitives is pragma Preelaborate; type Lock is new Integer; - type RTS_Lock is new Integer; - type Suspension_Object is new Integer; type Task_Body_Access is access procedure; @@ -45,7 +45,7 @@ package System.Task_Primitives is type Private_Data is limited record Thread : aliased Integer; CV : aliased Integer; - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; end record; subtype Task_Address is System.Address; diff --git a/gcc/ada/libgnarl/s-taspri__hpux-dce.ads b/gcc/ada/libgnarl/s-taspri__hpux-dce.ads index f2fba3e..9ec5dcb 100644 --- a/gcc/ada/libgnarl/s-taspri__hpux-dce.ads +++ b/gcc/ada/libgnarl/s-taspri__hpux-dce.ads @@ -34,6 +34,7 @@ -- This package provides low-level support for most tasking features with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -41,11 +42,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the later one serves only as a semaphore so - -- that do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -67,13 +63,11 @@ package System.Task_Primitives is private type Lock is record - L : aliased System.OS_Interface.pthread_mutex_t; + L : aliased System.OS_Locks.RTS_Lock; Priority : Integer; Owner_Priority : Integer; end record; - type RTS_Lock is new System.OS_Interface.pthread_mutex_t; - type Suspension_Object is record State : Boolean; pragma Atomic (State); @@ -84,7 +78,7 @@ private Waiting : Boolean; -- Flag showing if there is a task already suspended on this object - L : aliased System.OS_Interface.pthread_mutex_t; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for ensuring mutual exclusion on the Suspension_Object CV : aliased System.OS_Interface.pthread_cond_t; @@ -103,8 +97,9 @@ private -- are updated in atomic fashion. CV : aliased System.OS_Interface.pthread_cond_t; + -- Condition variable used to queue threads until condition is signaled - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnarl/s-taspri__lynxos.ads b/gcc/ada/libgnarl/s-taspri__lynxos.ads index 07d9be2..a330700 100644 --- a/gcc/ada/libgnarl/s-taspri__lynxos.ads +++ b/gcc/ada/libgnarl/s-taspri__lynxos.ads @@ -33,6 +33,7 @@ -- This is LynxOS Family version of this package. with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -40,11 +41,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the latter serves only as a semaphore so that - -- we do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -68,11 +64,9 @@ private type Lock is record RW : aliased System.OS_Interface.pthread_rwlock_t; - WO : aliased System.OS_Interface.pthread_mutex_t; + WO : aliased System.OS_Locks.RTS_Lock; end record; - type RTS_Lock is new System.OS_Interface.pthread_mutex_t; - type Suspension_Object is record State : Boolean; pragma Atomic (State); @@ -83,7 +77,7 @@ private Waiting : Boolean; -- Flag showing if there is a task already suspended on this object - L : aliased System.OS_Interface.pthread_mutex_t; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for ensuring mutual exclusion on the Suspension_Object CV : aliased System.OS_Interface.pthread_cond_t; @@ -105,9 +99,9 @@ private -- On targets where lwp is not relevant, this is equivalent to Thread. CV : aliased System.OS_Interface.pthread_cond_t; - -- Should be commented ??? (in all versions of taspri) + -- Condition variable used to queue threads until condition is signaled - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnarl/s-taspri__mingw.ads b/gcc/ada/libgnarl/s-taspri__mingw.ads index 426c4a3..a51f752 100644 --- a/gcc/ada/libgnarl/s-taspri__mingw.ads +++ b/gcc/ada/libgnarl/s-taspri__mingw.ads @@ -31,7 +31,7 @@ -- This is a NT (native) version of this package -with System.OS_Interface; +with System.OS_Locks; with System.Win32; package System.Task_Primitives is @@ -40,11 +40,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the later one serves only as a semaphore so - -- that do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -67,15 +62,13 @@ package System.Task_Primitives is private type Lock is record - Mutex : aliased System.OS_Interface.CRITICAL_SECTION; + Mutex : aliased System.OS_Locks.RTS_Lock; Priority : Integer; Owner_Priority : Integer; end record; type Condition_Variable is new System.Win32.HANDLE; - type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION; - type Suspension_Object is record State : Boolean; pragma Atomic (State); @@ -86,7 +79,7 @@ private Waiting : Boolean; -- Flag showing if there is a task already suspended on this object - L : aliased System.OS_Interface.CRITICAL_SECTION; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for ensuring mutual exclusion on the Suspension_Object CV : aliased Win32.HANDLE; @@ -108,7 +101,7 @@ private CV : aliased Condition_Variable; -- Condition Variable used to implement Sleep/Wakeup - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads b/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads index f9118c7..b92f1dd 100644 --- a/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads +++ b/gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads @@ -1,12 +1,12 @@ ------------------------------------------------------------------------------ -- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- --- S Y S T E M . T A S K _ P R I M I T I V E S -- +-- S Y S T E M . T A S K _ P R I M I T I V E S -- -- -- --- S p e c -- +-- S p e c -- -- -- --- Copyright (C) 1991-2017, Florida State University -- +-- Copyright (C) 1991-2017, Florida State University -- -- Copyright (C) 1995-2024, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- @@ -36,6 +36,7 @@ -- Note: this file can only be used for POSIX compliant systems with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -43,11 +44,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the later one serves only as a semaphore so - -- that do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -69,11 +65,9 @@ package System.Task_Primitives is private - type RTS_Lock is new System.OS_Interface.pthread_mutex_t; - type Lock is record - WO : aliased RTS_Lock; RW : aliased System.OS_Interface.pthread_rwlock_t; + WO : aliased System.OS_Locks.RTS_Lock; end record; type Suspension_Object is record @@ -86,7 +80,7 @@ private Waiting : Boolean; -- Flag showing if there is a task already suspended on this object - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for ensuring mutual exclusion on the Suspension_Object CV : aliased System.OS_Interface.pthread_cond_t; @@ -110,7 +104,7 @@ private CV : aliased System.OS_Interface.pthread_cond_t; -- Should be commented ??? (in all versions of taspri) - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnarl/s-taspri__posix.ads b/gcc/ada/libgnarl/s-taspri__posix.ads index 1fdfa83..4d0b379 100644 --- a/gcc/ada/libgnarl/s-taspri__posix.ads +++ b/gcc/ada/libgnarl/s-taspri__posix.ads @@ -35,6 +35,7 @@ -- Note: this file can only be used for POSIX compliant systems with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -42,11 +43,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the latter serves only as a semaphore so that - -- we do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -68,11 +64,9 @@ package System.Task_Primitives is private - type RTS_Lock is new System.OS_Interface.pthread_mutex_t; - type Lock is record RW : aliased System.OS_Interface.pthread_rwlock_t; - WO : aliased RTS_Lock; + WO : aliased System.OS_Locks.RTS_Lock; end record; type Suspension_Object is record @@ -85,7 +79,7 @@ private Waiting : Boolean; -- Flag showing if there is a task already suspended on this object - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for ensuring mutual exclusion on the Suspension_Object CV : aliased System.OS_Interface.pthread_cond_t; @@ -107,9 +101,9 @@ private -- On targets where lwp is not relevant, this is equivalent to Thread. CV : aliased System.OS_Interface.pthread_cond_t; - -- Should be commented ??? (in all versions of taspri) + -- Condition variable used to queue threads until condition is signaled - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnarl/s-taspri__solaris.ads b/gcc/ada/libgnarl/s-taspri__solaris.ads index 33bd87c..ca40229 100644 --- a/gcc/ada/libgnarl/s-taspri__solaris.ads +++ b/gcc/ada/libgnarl/s-taspri__solaris.ads @@ -36,6 +36,7 @@ with Ada.Unchecked_Conversion; with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -44,14 +45,8 @@ package System.Task_Primitives is type Lock_Ptr is access all Lock; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - type RTS_Lock_Ptr is access all RTS_Lock; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the later one serves only as a semaphore so - -- that do not check for ceiling violations. - function To_Lock_Ptr is - new Ada.Unchecked_Conversion (RTS_Lock_Ptr, Lock_Ptr); + new Ada.Unchecked_Conversion (OS_Locks.RTS_Lock_Ptr, Lock_Ptr); type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -74,31 +69,7 @@ package System.Task_Primitives is private - type Private_Task_Serial_Number is mod 2 ** Long_Long_Integer'Size; - -- Used to give each task a unique serial number - - type Base_Lock is new System.OS_Interface.mutex_t; - - type Owner_Int is new Integer; - for Owner_Int'Alignment use Standard'Maximum_Alignment; - - type Owner_ID is access all Owner_Int; - - function To_Owner_ID is - new Ada.Unchecked_Conversion (System.Address, Owner_ID); - - type Lock is record - L : aliased Base_Lock; - Ceiling : System.Any_Priority := System.Any_Priority'First; - Saved_Priority : System.Any_Priority := System.Any_Priority'First; - Owner : Owner_ID; - Next : Lock_Ptr; - Level : Private_Task_Serial_Number := 0; - Buddy : Owner_ID; - Frozen : Boolean := False; - end record; - - type RTS_Lock is new Lock; + type Lock is new OS_Locks.RTS_Lock; type Suspension_Object is record State : Boolean; @@ -133,7 +104,9 @@ private -- The LWP id of the thread. Set by self in Enter_Task CV : aliased System.OS_Interface.cond_t; - L : aliased RTS_Lock; + -- Condition variable used to queue threads until condition is signaled + + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L Active_Priority : System.Any_Priority := System.Any_Priority'First; diff --git a/gcc/ada/libgnarl/s-taspri__vxworks.ads b/gcc/ada/libgnarl/s-taspri__vxworks.ads index 9dc26c9..4c2aff8 100644 --- a/gcc/ada/libgnarl/s-taspri__vxworks.ads +++ b/gcc/ada/libgnarl/s-taspri__vxworks.ads @@ -32,6 +32,7 @@ -- This is a VxWorks version of this package with System.OS_Interface; +with System.OS_Locks; package System.Task_Primitives is pragma Preelaborate; @@ -39,11 +40,6 @@ package System.Task_Primitives is type Lock is limited private; -- Should be used for implementation of protected objects - type RTS_Lock is limited private; - -- Should be used inside the runtime system. The difference between Lock - -- and the RTS_Lock is that the later one serves only as a semaphore so - -- that do not check for ceiling violations. - type Suspension_Object is limited private; -- Should be used for the implementation of Ada.Synchronous_Task_Control @@ -65,17 +61,7 @@ package System.Task_Primitives is private - type Priority_Type is (Prio_None, Prio_Protect, Prio_Inherit); - - type Lock is record - Mutex : System.OS_Interface.SEM_ID; - Protocol : Priority_Type; - - Prio_Ceiling : System.OS_Interface.int; - -- Priority ceiling of lock - end record; - - type RTS_Lock is new Lock; + type Lock is new System.OS_Locks.RTS_Lock; type Suspension_Object is record State : Boolean; @@ -109,8 +95,9 @@ private -- On targets where lwp is not relevant, this is equivalent to Thread. CV : aliased System.OS_Interface.SEM_ID; + -- Condition variable used to queue threads until condition is signaled - L : aliased RTS_Lock; + L : aliased System.OS_Locks.RTS_Lock; -- Protection for all components is lock L end record; diff --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb index 89f5f29..028c9d7 100644 --- a/gcc/ada/libgnat/s-finpri.adb +++ b/gcc/ada/libgnat/s-finpri.adb @@ -32,8 +32,7 @@ with Ada.Exceptions; use Ada.Exceptions; with Ada.Unchecked_Conversion; -with System.Atomic_Primitives; use System.Atomic_Primitives; -with System.Soft_Links; use System.Soft_Links; +with System.Soft_Links; use System.Soft_Links; package body System.Finalization_Primitives is @@ -402,7 +401,7 @@ package body System.Finalization_Primitives is Collection.Head.Prev := Collection.Head'Unchecked_Access; Collection.Head.Next := Collection.Head'Unchecked_Access; - Collection.Lock := 0; + Initialize_RTS_Lock (Collection.Lock'Address); end Initialize; --------------------- @@ -411,9 +410,7 @@ package body System.Finalization_Primitives is procedure Lock_Collection (Collection : in out Finalization_Collection) is begin - while Atomic_Test_And_Set (Collection.Lock'Address, Acquire) loop - null; - end loop; + Acquire_RTS_Lock (Collection.Lock'Address); end Lock_Collection; ------------------------------------- @@ -430,10 +427,8 @@ package body System.Finalization_Primitives is ----------------------- procedure Unlock_Collection (Collection : in out Finalization_Collection) is - procedure Lock_Store is new Atomic_Store (Lock_Type); - begin - Lock_Store (Collection.Lock'Address, 0, Release); + Release_RTS_Lock (Collection.Lock'Address); end Unlock_Collection; end System.Finalization_Primitives; diff --git a/gcc/ada/libgnat/s-finpri.ads b/gcc/ada/libgnat/s-finpri.ads index b0b662ca..62c2474 100644 --- a/gcc/ada/libgnat/s-finpri.ads +++ b/gcc/ada/libgnat/s-finpri.ads @@ -31,6 +31,7 @@ with Ada.Finalization; +with System.OS_Locks; with System.Storage_Elements; -- This package encapsulates the types and operations used by the compiler @@ -251,9 +252,8 @@ private -- of a collection. The allocations must raise Program_Error. This may -- arise in a multitask environment. - Lock : Lock_Type; - pragma Atomic (Lock); - -- A spinlock to synchronize concurrent accesses to the collection + Lock : aliased System.OS_Locks.RTS_Lock; + -- A lock to synchronize concurrent accesses to the collection end record; -- This operation is very simple and thus can be performed in line diff --git a/gcc/ada/libgnat/s-oslock__dummy.ads b/gcc/ada/libgnat/s-oslock__dummy.ads new file mode 100644 index 0000000..88e52e8 --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__dummy.ads @@ -0,0 +1,39 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a no tasking version of this package + +package System.OS_Locks is + pragma Preelaborate; + + type RTS_Lock is new Boolean; + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-oslock__hpux-dce.ads b/gcc/ada/libgnat/s-oslock__hpux-dce.ads new file mode 100644 index 0000000..824c395 --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__hpux-dce.ads @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the HP-UX version of this package + +with Interfaces.C; +with System.OS_Constants; + +package System.OS_Locks is + pragma Preelaborate; + + type pthread_mutex_t is limited private; + + subtype RTS_Lock is pthread_mutex_t; + -- Should be used inside the runtime system. The difference between Lock + -- and the RTS_Lock is that the latter serves only as a semaphore so that + -- we do not check for ceiling violations. + +private + + type cma_t_address is new System.Address; + + type cma_t_handle is record + field1 : cma_t_address; + field2 : Short_Integer; + field3 : Short_Integer; + end record; + for cma_t_handle'Size use 64; + + type pthread_mutex_t is new cma_t_handle; + pragma Convention (C_Pass_By_Copy, pthread_mutex_t); + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-oslock__mingw.ads b/gcc/ada/libgnat/s-oslock__mingw.ads new file mode 100644 index 0000000..e5fdb7f --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__mingw.ads @@ -0,0 +1,62 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a NT (native) version of this package + +with Interfaces.C; +with System.Win32; + +package System.OS_Locks is + pragma Preelaborate; + + type CRITICAL_SECTION is limited private; + + subtype RTS_Lock is CRITICAL_SECTION; + -- Should be used inside the runtime system. The difference between Lock + -- and the RTS_Lock is that the later one serves only as a semaphore so + -- that do not check for ceiling violations. + +private + + type CRITICAL_SECTION is record + DebugInfo : System.Address; + + LockCount : Long_Integer; + RecursionCount : Long_Integer; + OwningThread : Win32.HANDLE; + -- The above three fields control entering and exiting the critical + -- section for the resource. + + LockSemaphore : Win32.HANDLE; + SpinCount : Interfaces.C.size_t; + end record; + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-oslock__posix.ads b/gcc/ada/libgnat/s-oslock__posix.ads new file mode 100644 index 0000000..e2c237f --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__posix.ads @@ -0,0 +1,57 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a POSIX-like version of this package + +with Interfaces.C; +with System.OS_Constants; + +package System.OS_Locks is + pragma Preelaborate; + + type pthread_mutex_t is limited private; + + subtype RTS_Lock is pthread_mutex_t; + -- Should be used inside the runtime system. The difference between Lock + -- and the RTS_Lock is that the latter serves only as a semaphore so that + -- we do not check for ceiling violations. + +private + + subtype char_array is Interfaces.C.char_array; + + type pthread_mutex_t is record + Data : char_array (1 .. OS_Constants.PTHREAD_MUTEX_SIZE); + end record; + pragma Convention (C, pthread_mutex_t); + for pthread_mutex_t'Alignment use Interfaces.C.unsigned_long'Alignment; + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-oslock__solaris.ads b/gcc/ada/libgnat/s-oslock__solaris.ads new file mode 100644 index 0000000..8cf7c69 --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__solaris.ads @@ -0,0 +1,84 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a Solaris (native) version of this package + +with Interfaces.C; + +package System.OS_Locks is + pragma Preelaborate; + + type mutex_t is limited private; + + type Private_Task_Serial_Number is mod 2 ** Long_Long_Integer'Size; + -- Used to give each task a unique serial number + + type Owner_Int is new Integer; + for Owner_Int'Alignment use Standard'Maximum_Alignment; + + type Owner_ID is access all Owner_Int; + + function To_Owner_ID is + new Ada.Unchecked_Conversion (System.Address, Owner_ID); + + type RTS_Lock; + type RTS_Lock_Ptr is access all RTS_Lock; + + type RTS_Lock is record + L : aliased mutex_t; + Ceiling : System.Any_Priority := System.Any_Priority'First; + Saved_Priority : System.Any_Priority := System.Any_Priority'First; + Owner : Owner_ID; + Next : RTS_Lock_Ptr; + Level : Private_Task_Serial_Number := 0; + Buddy : Owner_ID; + Frozen : Boolean := False; + end record; + +private + + type array_type_9 is array (0 .. 3) of unsigned_char; + type record_type_3 is record + flag : array_type_9; + Xtype : unsigned_long; + end record; + pragma Convention (C, record_type_3); + + type upad64_t is new Interfaces.Unsigned_64; + + type mutex_t is record + flags : record_type_3; + lock : upad64_t; + data : upad64_t; + end record; + pragma Convention (C, mutex_t); + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-oslock__vxworks.ads b/gcc/ada/libgnat/s-oslock__vxworks.ads new file mode 100644 index 0000000..c819d1af --- /dev/null +++ b/gcc/ada/libgnat/s-oslock__vxworks.ads @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ L O C K S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2024, 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/>. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a VxWorks version of this package + +with Interfaces.C; +with System.VxWorks.Ext; + +package System.OS_Locks is + pragma Preelaborate; + + type Priority_Type is (Prio_None, Prio_Protect, Prio_Inherit); + + type RTS_Lock is record + Mutex : System.VxWorks.Ext.SEM_ID; + Protocol : Priority_Type; + Prio_Ceiling : Interfaces.C.int; + end record; + +end System.OS_Locks; diff --git a/gcc/ada/libgnat/s-soflin.ads b/gcc/ada/libgnat/s-soflin.ads index 5cf5a8b..e882680 100644 --- a/gcc/ada/libgnat/s-soflin.ads +++ b/gcc/ada/libgnat/s-soflin.ads @@ -251,6 +251,20 @@ package System.Soft_Links is Get_Stack_Info : Get_Stack_Access_Call := Get_Stack_Info_NT'Access; + ---------------------- + -- Locking Soft-Links -- + ---------------------- + + procedure Null_Set_Address (Addr : Address) is null; + + -- Soft-Links are used for procedures that manipulate locks to avoid + -- dragging the tasking run time when using access-to-controlled types. + + Initialize_RTS_Lock : Set_Address_Call := Null_Set_Address'Access; + Finalize_RTS_Lock : Set_Address_Call := Null_Set_Address'Access; + Acquire_RTS_Lock : Set_Address_Call := Null_Set_Address'Access; + Release_RTS_Lock : Set_Address_Call := Null_Set_Address'Access; + -------------------------- -- Master_Id Soft-Links -- -------------------------- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 5f402cf..e56a408 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1919,6 +1919,10 @@ package Opt is -- be in the spec of Expander, but it is referenced by Errout, and it -- really seems wrong for Errout to depend on Expander. + Interface_Seen : Boolean := False; + -- Set True by the parser if the "interface" reserved word is seen. This is + -- needed in Exp_Ch7 (see that package for documentation). + Tagged_Seen : Boolean := False; -- Set True by the parser if the "tagged" reserved word is seen. This is -- needed in Exp_Put_Image (see that package for documentation). diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 4e512b9..946da34 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -30,8 +30,8 @@ -- -- ------------------------------------------------------------------------------ -pragma Style_Checks ("M32766"); --- Allow long lines +pragma Style_Checks ("N"); +-- Disable style checks */ diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 0a9c4a8..9b1d00e 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -2725,9 +2725,12 @@ package body Scng is Accumulate_Token_Checksum; Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name)); + if Token = Tok_Interface then + Interface_Seen := True; + -- See Exp_Put_Image for documentation of Tagged_Seen - if Token = Tok_Tagged then + elsif Token = Tok_Tagged then Tagged_Seen := True; end if; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 73e5388..82b4e1c 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -31,6 +31,7 @@ with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Errout; use Errout; +with Exp_Ch7; with Exp_Disp; use Exp_Disp; with Exp_Put_Image; with Exp_Util; use Exp_Util; @@ -925,6 +926,8 @@ package body Sem_Ch10 is Set_Context_Pending (N, False); + Exp_Ch7.Preload_Finalization_Collection (N); + -- If the unit is a package body, the spec is already loaded and must be -- analyzed first, before we analyze the body. |