OSDN > 浏览软件 > Portable Assembler Framework > SCM > hg > PAF > 提交

Portable Assembler Framework
Fork
PAF
Ada95FL

PAF: 提交

New main repository

GCC atomic primitives

diff -r 730ef9db090e -r e6c4ee6f8a55 Source/Compiler_Specific/Fallback/PAF.Atomic_Operations.ads

--- a/Source/Compiler_Specific/Fallback/PAF.Atomic_Operations.ads Sat Sep 03 11:52:21 2022 +0300

+++ b/Source/Compiler_Specific/Fallback/PAF.Atomic_Operations.ads Mon Sep 05 20:38:29 2022 +0300

		@@ -34,7 +34,7 @@
34	34	private
35	35
36	36	type Atomic_32 is limited record
37		- Value : Integer_32;
	37	+ Value : aliased Integer_32;
38	38	end record;
39	39
40	40	end PAF.Atomic_Operations;

diff -r 730ef9db090e -r e6c4ee6f8a55 Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.adb

--- a/Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.adb Sat Sep 03 11:52:21 2022 +0300

+++ b/Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.adb Mon Sep 05 20:38:29 2022 +0300

		@@ -14,8 +14,14 @@
14	14	-- limitations under the License. --
15	15	------------------------------------------------------------------------------
16	16
	17	+with System;
	18	+with System.Machine_Code;
	19	+with PAF.GCC_Atomic;
	20	+
17	21	package body PAF.Atomic_Operations is
18	22
	23	+ package Memory_Order renames PAF.GCC_Atomic.Memory_Order;
	24	+
19	25	-----------
20	26	-- Value --
21	27	-----------

		@@ -35,6 +41,22 @@
35	41	Item.Value := New_Value;
36	42	end Set_Value_Non_Atomic;
37	43
	44	+ ------------------------------------------
	45	+ -- Intrinsic_Atomic_Compare_Exchange_32 --
	46	+ ------------------------------------------
	47	+
	48	+ function Intrinsic_Atomic_Compare_Exchange_32
	49	+ (Ptr : System.Address;
	50	+ Expected : System.Address;
	51	+ Desired : Integer_32;
	52	+ Weak : Boolean := False;
	53	+ Success_Model : Memory_Order.Memory_Model := Memory_Order.Sequentially_Consistent;
	54	+ Failure_Model : Memory_Order.Memory_Model := Memory_Order.Sequentially_Consistent) return Boolean;
	55	+
	56	+ pragma Import
	57	+ (Intrinsic, Intrinsic_Atomic_Compare_Exchange_32,
	58	+ "__atomic_compare_exchange_4");
	59	+
38	60	----------------------
39	61	-- Compare_Exchange --
40	62	----------------------

		@@ -43,15 +65,15 @@
43	65	(Target : in out Atomic_32;
44	66	Shadow_Copy : in out Integer_32;
45	67	New_Value : Integer_32;
46		- Success : out Boolean) is
	68	+ Success : out Boolean)
	69	+ is
	70	+ Local_Success : constant Boolean := Intrinsic_Atomic_Compare_Exchange_32
	71	+ (Target.Value'Address, Shadow_Copy'Address, New_Value);
47	72	begin
48		- if Target.Value = Shadow_Copy then
49		- Target.Value := New_Value;
	73	+ Success := Local_Success;
	74	+
	75	+ if Local_Success then
50	76	Shadow_Copy := New_Value;
51		- Success := True;
52		- else
53		- Shadow_Copy := Target.Value;
54		- Success := False;
55	77	end if;
56	78	end Compare_Exchange;
57	79

		@@ -61,7 +83,10 @@
61	83
62	84	procedure Yield_Processor is
63	85	begin
64		- null;
	86	+ -- x86/x64:
	87	+ System.Machine_Code.Asm
	88	+ (Template => "pause", Clobber => "memory", Volatile => True);
	89	+ -- arm: yield
65	90	end Yield_Processor;
66	91
67	92	end PAF.Atomic_Operations;

diff -r 730ef9db090e -r e6c4ee6f8a55 Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.ads

--- a/Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.ads Sat Sep 03 11:52:21 2022 +0300

+++ b/Source/Compiler_Specific/GNAT/PAF.Atomic_Operations.ads Mon Sep 05 20:38:29 2022 +0300

		@@ -34,9 +34,13 @@
34	34	private
35	35
36	36	type Atomic_32 is limited record
37		- Value : Integer_32;
	37	+ Value : aliased Integer_32;
38	38	pragma Atomic (Value);
39	39	pragma Volatile (Value);
40	40	end record;
41	41
	42	+ -- pragma Import (Intrinsic, Yield_Processor, "__yield");
	43	+ -- pragma Import (Intrinsic, Yield_Processor, "_mm_pause");
	44	+ pragma Inline (Yield_Processor);
	45	+
42	46	end PAF.Atomic_Operations;

diff -r 730ef9db090e -r e6c4ee6f8a55 Source/Compiler_Specific/GNAT/PAF.GCC_Atomic.ads

--- /dev/null Thu Jan 01 00:00:00 1970 +0000

+++ b/Source/Compiler_Specific/GNAT/PAF.GCC_Atomic.ads Mon Sep 05 20:38:29 2022 +0300

		@@ -0,0 +1,35 @@
	1	+------------------------------------------------------------------------------
	2	+-- Copyright 2022 Levashev Ivan Aleksandrovich --
	3	+-- --
	4	+-- Licensed under the Apache License, Version 2.0 (the "License"); --
	5	+-- you may not use this file except in compliance with the License. --
	6	+-- You may obtain a copy of the License at --
	7	+-- --
	8	+-- http://www.apache.org/licenses/LICENSE-2.0 --
	9	+-- --
	10	+-- Unless required by applicable law or agreed to in writing, software --
	11	+-- distributed under the License is distributed on an "AS IS" BASIS, --
	12	+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --
	13	+-- See the License for the specific language governing permissions and --
	14	+-- limitations under the License. --
	15	+------------------------------------------------------------------------------
	16	+
	17	+package PAF.GCC_Atomic is
	18	+
	19	+ package Memory_Order is
	20	+ -- https://gcc.gnu.org/wiki/Atomic/GCCMM/AtomicSync
	21	+ -- https://gcc.gnu.org/onlinedocs/gcc/_005f_005fatomic-Builtins.html
	22	+
	23	+ Sequentially_Consistent : constant := 5;
	24	+ Relaxed : constant := 0;
	25	+ Acquire : constant := 2;
	26	+ Release : constant := 3;
	27	+ Acquire_Release : constant := 4;
	28	+
	29	+ -- Consume : constant := 1;
	30	+
	31	+ subtype Memory_Model is Integer range Relaxed .. 6;
	32	+
	33	+ end Memory_Order;
	34	+
	35	+end PAF.GCC_Atomic;

diff -r 730ef9db090e -r e6c4ee6f8a55 Source/PAF.Referencing.Types.ads

--- a/Source/PAF.Referencing.Types.ads Sat Sep 03 11:52:21 2022 +0300

+++ b/Source/PAF.Referencing.Types.ads Mon Sep 05 20:38:29 2022 +0300

		@@ -38,9 +38,12 @@
38	38	procedure Release
39	39	(Object : access Referenced;
40	40	Deallocate : out Referenced_Deallocator) is abstract;
	41	+
	42	+ -- Before_Destruction, Destroy, Unchecked_Deallocation => Finalize
41	43	procedure Deallocate (Object : in out Referenced_Access);
42	44
43		- package Conversions is new System.Address_To_Access_Conversions (Object => Referenced'Class);
	45	+ package Conversions is new System.Address_To_Access_Conversions
	46	+ (Object => Referenced'Class);
44	47
45	48	type Referenced_By_Counter is new Referenced with private;
46	49