OSDN > 浏览软件 > referencing > SCM > hg > Referencing > 提交

referencing
Fork
Referencing
Fast_Strings
AdaMagic_Experiments

Referencing: 提交

Reference counting smart pointers library for Ada

Enables inner tagged types operations to accept and return references wrapping these types' accesses by using special tricks. This way naked unsafe access values can mostly be eliminated, something that other smart pointers fail to provide.

Commit MetaInfo

修订版	7ab19e93dc9d40e27a297d9aa4a8d949c8b39a68 (tree)
时间	2019-09-08 15:09:07
作者	Sergey Dukov <dukov54@live...>
Commiter	Sergey Dukov

Log Message

Create ADA95-Branch

#32737

更改概述

modified: Referencing.gpr (diff)
modified: Referencing_Common.gpr (diff)
modified: Referencing_Tester.gpr (diff)
modified: Source/Debug/Referencing.Debug.ads (diff)
modified: Source/Referencing.References.adb (diff)
modified: Source/Referencing.References.ads (diff)
modified: Source/Referencing.Types.Operations.Debug_Prints.adb (diff)
modified: Source/Referencing.Types.Operations.adb (diff)
modified: Source/Referencing.Types.Operations.ads (diff)
modified: Source/Referencing.Types.ads (diff)
modified: Source/Referencing.ads (diff)
modified: Tester/Output.txt (diff)
modified: Tester/Referencing.Tester.Main.adb (diff)
modified: Tester/Referencing.Tester.adb (diff)
modified: Tester/Referencing.Tester.ads (diff)
add: Source/Atomic_Counters.adb (diff)
add: Source/Atomic_Counters.ads (diff)
add: build/build.txt (diff)

差异

diff -r 52ac65006ea3 -r 7ab19e93dc9d Referencing.gpr

--- a/Referencing.gpr Thu Jun 21 03:17:39 2018 +0200

+++ b/Referencing.gpr Sun Sep 08 10:09:07 2019 +0400

		@@ -52,4 +52,7 @@
52	52
53	53	package Compiler renames Referencing_Common.Compiler;
54	54
	55	+ for Excluded_Source_Files use ("Referencing.Types.Operations.Debug_Prints.adb");
	56	+
55	57	end Referencing;
	58	+

diff -r 52ac65006ea3 -r 7ab19e93dc9d Referencing_Common.gpr

--- a/Referencing_Common.gpr Thu Jun 21 03:17:39 2018 +0200

+++ b/Referencing_Common.gpr Sun Sep 08 10:09:07 2019 +0400

		@@ -27,8 +27,8 @@
27	27	package Naming is
28	28	for Casing use "mixedcase";
29	29	for Dot_Replacement use ".";
30		- for Spec_Suffix ("Ada") use ".ads";
31		- for Body_Suffix ("Ada") use ".adb";
	30	+ for Spec_Suffix ("ada") use ".ads";
	31	+ for Body_Suffix ("ada") use ".adb";
32	32	for Separate_Suffix use ".ada";
33	33	end Naming;
34	34

		@@ -37,7 +37,7 @@
37	37	-------------
38	38
39	39	package Builder is
40		- for Default_Switches ("Ada") use ("-s"); -- Recompile if compiler switches have changed
	40	+ for Default_Switches ("ada") use ("-s"); -- Recompile if compiler switches have changed
41	41	end Builder;
42	42
43	43	------------

		@@ -45,8 +45,7 @@
45	45	------------
46	46
47	47	package Linker is
48		- for Default_Switches ("Ada") use
49		- ("-g"); -- debug information
	48	+ for Default_Switches ("ada") use ("-g");
50	49	end Linker;
51	50
52	51	------------

		@@ -54,10 +53,7 @@
54	53	------------
55	54
56	55	package Binder is
57		- for Default_Switches ("Ada") use
58		- ("-y", -- leap seconds
59		- "-E", -- exception traceback
60		- "-g"); -- debug information
	56	+ for Default_Switches ("ada") use ("-y", "-E", "-g");
61	57	end Binder;
62	58
63	59	--------------

		@@ -65,16 +61,16 @@
65	61	--------------
66	62
67	63	package Compiler is
68		- for Default_Switches ("Ada") use
69		- ("-fstack-check", -- stack checking
70		- "-gnata", -- enable assertions
71		- "-gnat12", -- Ada 2012
72		- "-gnatW8", -- UTF-8
73		- "-gnatA", -- avoid processing `gnat.adc'
74		- "-gnatn", -- backend inlining
75		- "-gnato", -- overflow checking
76		- "-gnatVa", -- validity checks
77		- "-g"); -- debug information
	64	+ for Default_Switches ("ada") use (
	65	+ "-fstack-check",
	66	+ "-gnata",
	67	+ "-gnatA",
	68	+ "-gnatn",
	69	+ "-gnato",
	70	+ "-g", "-O0",
	71	+ "-gnat95",
	72	+ "-gnatVa");
78	73	end Compiler;
79	74
80	75	end Referencing_Common;
	76	+

diff -r 52ac65006ea3 -r 7ab19e93dc9d Referencing_Tester.gpr

--- a/Referencing_Tester.gpr Thu Jun 21 03:17:39 2018 +0200

+++ b/Referencing_Tester.gpr Sun Sep 08 10:09:07 2019 +0400

		@@ -56,10 +56,12 @@
56	56	-- Compiler --
57	57	--------------
58	58
59		- package Compiler extends Referencing_Common.Compiler is
60		- for Default_Switches ("Ada") use
61		- Referencing_Common.Compiler'Default_Switches ("Ada") &
62		- "-O3"; -- Maximal optimization for stress testing
63		- end Compiler;
	59	+-- package Compiler extends Referencing_Common.Compiler is
	60	+-- for Default_Switches ("Ada") use
	61	+-- Referencing_Common.Compiler'Default_Switches ("Ada") &
	62	+-- "-O3"; -- Maximal optimization for stress testing
	63	+-- end Compiler;
	64	+
	65	+ package Compiler renames Referencing_Common.Compiler;
64	66
65	67	end Referencing_Tester;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Atomic_Counters.adb

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

+++ b/Source/Atomic_Counters.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -0,0 +1,71 @@
	1	+package body Atomic_Counters is
	2	+
	3	+ procedure Sync_Add_And_Fetch
	4	+ (Ptr : access Atomic_Unsigned;
	5	+ Value : Atomic_Unsigned);
	6	+ pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
	7	+
	8	+ function Sync_Sub_And_Fetch
	9	+ (Ptr : access Atomic_Unsigned;
	10	+ Value : Atomic_Unsigned) return Atomic_Unsigned;
	11	+ pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
	12	+
	13	+ ---------------
	14	+ -- Decrement --
	15	+ ---------------
	16	+
	17	+ procedure Decrement (Item : in out Atomic_Unsigned; Result : out Boolean) is
	18	+ begin
	19	+ Result := Sync_Sub_And_Fetch (Item'Unrestricted_Access, 1) = 0;
	20	+ end Decrement;
	21	+
	22	+
	23	+ procedure Decrement (Item : in out Atomic_Counter; Result : out Boolean) is
	24	+ begin
	25	+ -- Note: the use of Unrestricted_Access here is required because we
	26	+ -- are obtaining an access-to-volatile pointer to a non-volatile object.
	27	+ -- This is not allowed for [Unchecked_]Access, but is safe in this case
	28	+ -- because we know that no aliases are being created.
	29	+
	30	+ Result := Sync_Sub_And_Fetch (Item.Value'Unrestricted_Access, 1) = 0;
	31	+ end Decrement;
	32	+
	33	+ ---------------
	34	+ -- Increment --
	35	+ ---------------
	36	+
	37	+ procedure Increment (Item : in out Atomic_Unsigned) is
	38	+ begin
	39	+ Sync_Add_And_Fetch (Item'Unrestricted_Access, 1);
	40	+ end Increment;
	41	+
	42	+ procedure Increment (Item : in out Atomic_Counter) is
	43	+ begin
	44	+ -- Note: the use of Unrestricted_Access here is required because we are
	45	+ -- obtaining an access-to-volatile pointer to a non-volatile object.
	46	+ -- This is not allowed for [Unchecked_]Access, but is safe in this case
	47	+ -- because we know that no aliases are being created.
	48	+
	49	+ Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
	50	+ end Increment;
	51	+
	52	+ ----------------
	53	+ -- Initialize --
	54	+ ----------------
	55	+
	56	+ procedure Initialize (Item : out Atomic_Counter) is
	57	+ begin
	58	+ Item.Value := 1;
	59	+ end Initialize;
	60	+
	61	+ ------------
	62	+ -- Is_One --
	63	+ ------------
	64	+
	65	+ function Is_One (Item : Atomic_Counter) return Boolean is
	66	+ begin
	67	+ return Item.Value = 1;
	68	+ end Is_One;
	69	+
	70	+
	71	+end Atomic_Counters;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Atomic_Counters.ads

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

+++ b/Source/Atomic_Counters.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -0,0 +1,71 @@
	1	+package Atomic_Counters is
	2	+
	3	+ pragma Pure;
	4	+ pragma Preelaborate;
	5	+
	6	+ type Atomic_Counter is private;
	7	+ -- Type for atomic counter objects. Note, initial value of the counter is
	8	+ -- one. This allows using an atomic counter as member of record types when
	9	+ -- object of these types are created at library level in preelaborable
	10	+ -- compilation units.
	11	+ --
	12	+ -- Atomic_Counter is declared as private limited type to provide highest
	13	+ -- level of protection from unexpected use. All available operations are
	14	+ -- declared below, and this set should be as small as possible.
	15	+ -- Increment/Decrement operations for this type raise Program_Error on
	16	+ -- platforms not supporting the atomic primitives.
	17	+
	18	+ procedure Increment (Item : in out Atomic_Counter);
	19	+ pragma Inline_Always (Increment);
	20	+ -- Increments value of atomic counter.
	21	+
	22	+ procedure Decrement (Item : in out Atomic_Counter; Result : out Boolean);
	23	+ pragma Inline_Always (Decrement);
	24	+ -- Decrements value of atomic counter, returns True when value reach zero
	25	+
	26	+ function Is_One (Item : Atomic_Counter) return Boolean;
	27	+ pragma Inline_Always (Is_One);
	28	+ -- Returns True when value of the atomic counter is one
	29	+
	30	+ procedure Initialize (Item : out Atomic_Counter);
	31	+ pragma Inline_Always (Initialize);
	32	+ -- Initialize counter by setting its value to one. This subprogram is
	33	+ -- intended to be used in special cases when the counter object cannot be
	34	+ -- initialized in standard way.
	35	+
	36	+ type Atomic_Unsigned is mod 2 ** 32; -- with Default_Value => 0, Atomic;
	37	+ pragma Atomic(Atomic_Unsigned);
	38	+ -- Modular compatible atomic unsigned type.
	39	+ -- Increment/Decrement operations for this type are atomic only on
	40	+ -- supported platforms. See top of the file.
	41	+
	42	+ procedure Increment
	43	+ (Item : in out Atomic_Unsigned);
	44	+ pragma Inline_Always (Increment);
	45	+ -- Increments value of atomic counter
	46	+
	47	+-- function Decrement
	48	+-- (Item : aliased in out Atomic_Unsigned) return Boolean;
	49	+-- pragma Inline_Always (Decrement);
	50	+
	51	+ procedure Decrement
	52	+ (Item : in out Atomic_Unsigned; Result : out Boolean);
	53	+ -- Decrements value of atomic counter
	54	+ pragma Inline_Always (Decrement);
	55	+
	56	+ -- The "+" and "-" abstract routine provided below to disable BT := BT + 1
	57	+ -- constructions.
	58	+
	59	+ function "+"
	60	+ (Left, Right : Atomic_Unsigned) return Atomic_Unsigned is abstract;
	61	+
	62	+ function "-"
	63	+ (Left, Right : Atomic_Unsigned) return Atomic_Unsigned is abstract;
	64	+
	65	+private
	66	+
	67	+ type Atomic_Counter is record
	68	+ Value : aliased Atomic_Unsigned := 1;
	69	+ pragma Atomic (Value);
	70	+ end record;
	71	+end Atomic_Counters;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Debug/Referencing.Debug.ads

--- a/Source/Debug/Referencing.Debug.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Debug/Referencing.Debug.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -14,7 +14,7 @@
14	14	-- limitations under the License. --
15	15	------------------------------------------------------------------------------
16	16
17		-package Referencing.Debug with Preelaborate is
	17	+package Referencing.Debug is
18	18
19	19	type Put_Line_Type is access procedure (Item : String);
20	20

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.References.adb

--- a/Source/Referencing.References.adb Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.References.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -14,9 +14,6 @@
14	14	-- limitations under the License. --
15	15	------------------------------------------------------------------------------
16	16
17		-with System;
18		-with System.Address_To_Access_Conversions;
19		-
20	17	with Referencing.Types.Operations;
21	18
22	19	package body Referencing.References is

		@@ -31,10 +28,10 @@
31	28	-- Assigned --
32	29	--------------
33	30
34		- function Assigned
35		- (Object : Reference'Class)
36		- return Boolean is
37		- (Reference_Base (Object).Internal_Access /= Null_Access);
	31	+ function Assigned (Object : Reference'Class) return Boolean is
	32	+ begin
	33	+ return Reference_Base (Object).Internal_Access /= Null_Access;
	34	+ end Assigned;
38	35
39	36	------------
40	37	-- Assign --

		@@ -63,8 +60,10 @@
63	60	if Saved_Target_Access /= Null_Access then
64	61	declare
65	62	Upcasted : Types.Operations.Referenced_Access := Upcast (Saved_Target_Access);
	63	+ bReleased : Boolean;
66	64	begin
67		- if Types.Operations.Release (Upcasted.all) then
	65	+ Types.Operations.Release (Upcasted.all, bReleased);
	66	+ if bReleased then
68	67	Referencing.Types.Operations.Free (Upcasted);
69	68	end if;
70	69	end;

		@@ -89,9 +88,11 @@
89	88
90	89	if Saved_Target_Access /= Null_Access then
91	90	declare
92		- Upcasted : Types.Operations.Referenced_Access := Upcast (Saved_Target_Access);
	91	+ Upcasted : Types.Operations.Referenced_Access := Upcast (Saved_Target_Access);
	92	+ bReleased : Boolean;
93	93	begin
94		- if Types.Operations.Release (Upcasted.all) then
	94	+ Types.Operations.Release (Upcasted.all, bReleased);
	95	+ if bReleased then
95	96	Referencing.Types.Operations.Free (Upcasted);
96	97	end if;
97	98	end;

		@@ -102,10 +103,10 @@
102	103	-- Get --
103	104	---------
104	105
105		- function Get
106		- (Object : in Reference'Class)
107		- return Classwide_Access is
108		- (Reference_Base (Object).Internal_Access);
	106	+ function Get (Object : in Reference'Class) return Classwide_Access is
	107	+ begin
	108	+ return Reference_Base (Object).Internal_Access;
	109	+ end Get;
109	110
110	111	---------
111	112	-- Set --

		@@ -140,63 +141,63 @@
140	141
141	142	if Saved_Object_Access /= Null_Access then
142	143	declare
143		- Upcasted : Types.Operations.Referenced_Access := Upcast (Saved_Object_Access);
	144	+ Upcasted : Types.Operations.Referenced_Access := Upcast (Saved_Object_Access);
	145	+ bReleased : Boolean;
144	146	begin
145		- if Types.Operations.Release (Upcasted.all) then
	147	+ Types.Operations.Release (Upcasted.all, bReleased);
	148	+ if bReleased then
146	149	Referencing.Types.Operations.Free (Upcasted);
147	150	end if;
148	151	end;
149	152	end if;
150	153	end Set_And_Retain;
151	154
152		- type Mutable_Limited_Reference is limited record
153		- Data : access Reference;
	155	+ type Mutable_AUX_Reference is record
	156	+ Data : Reference_Ptr;
154	157	Wrapped : aliased Reference;
155	158	end record;
156	159
157		- pragma Assert (Mutable_Limited_Reference'Size = Limited_Reference_Base'Size);
158		- pragma Assert (Mutable_Limited_Reference'Alignment = Limited_Reference_Base'Alignment);
	160	+ pragma Assert (Mutable_AUX_Reference'Size = AUX_Reference_Base'Size);
	161	+ pragma Assert (Mutable_AUX_Reference'Alignment = AUX_Reference_Base'Alignment);
159	162
160		- package Limited_Reference_Conversions is new
161		- System.Address_To_Access_Conversions
162		- (Limited_Reference_Base);
163		- subtype Limited_Reference_Access is Limited_Reference_Conversions.Object_Pointer;
	163	+ type AUX_Reference_Access is access all Mutable_AUX_Reference;
	164	+ function To_Pointer is
	165	+ new Ada.Unchecked_Conversion (System.Address, AUX_Reference_Access);
164	166
165		- ------------------------------
166		- -- Create_Limited_Reference --
167		- ------------------------------
	167	+ --------------------------
	168	+ -- Create_AUX_Reference --
	169	+ --------------------------
168	170
169		- function Create_Limited_Reference
170		- return Limited_Reference_Base
	171	+ function Create_AUX_Reference
	172	+ return AUX_Reference_Base
171	173	is
172		- Dummy : aliased Reference with Import, Address => Dummy_Structure'Address;
	174	+ Dummy_Ptr : Reference_Ptr := To_Pointer(Dummy_Structure'Address);
	175	+ Result : aliased AUX_Reference_Base (Data => Dummy_Ptr);
173	176	begin
174		- return Result : aliased Limited_Reference_Base (Data => Dummy'Unchecked_Access) do
175		- declare
176		- Mutable_Result : Mutable_Limited_Reference
177		- with Import,
178		- Address => Limited_Reference_Conversions.To_Address
179		- (Result'Unchecked_Access);
180		- begin
181		- pragma Assert (Mutable_Result.Data = Dummy'Unchecked_Access);
182		- Mutable_Result.Data := Result.Wrapped'Unchecked_Access;
183		- end;
184		- end return;
185		- end Create_Limited_Reference;
	177	+ declare
	178	+ Mutable_Result_Ptr : AUX_Reference_Access :=
	179	+ To_Pointer (Result'Address);
	180	+ begin
	181	+ pragma Assert (Mutable_Result_Ptr.Data = Dummy_Ptr);
	182	+ Mutable_Result_Ptr.Data := Result.Wrapped'Unchecked_Access;
	183	+ end;
	184	+ return Result;
	185	+ end Create_AUX_Reference;
186	186
187	187	-----------------------
188	188	-- Create_And_Retain --
189	189	-----------------------
190	190
191		- function Create_And_Retain (Object : Classwide_Access) return Limited_Reference_Base is
	191	+ function Create_And_Retain (Object : Classwide_Access)
	192	+ return AUX_Reference_Base is
	193	+ Result : AUX_Reference_Base := Create_AUX_Reference;
	194	+ Result_Ptr : Reference_Ptr := To_Pointer(Result'Address);
192	195	begin
193		- return Result : Limited_Reference_Base := Create_Limited_Reference do
194		- if Object /= Null_Access then
195		- Types.Operations.Retain (Upcast (Object).all);
196		- end if;
197		-
198		- Operations.Set (Result, Object);
199		- end return;
	196	+ if Object /= Null_Access then
	197	+ Types.Operations.Retain (Upcast (Object).all);
	198	+ end if;
	199	+ Operations.Set (Result_Ptr.all, Object);
	200	+ return Result;
200	201	end Create_And_Retain;
201	202
202	203	end Operations;

		@@ -205,7 +206,6 @@
205	206	-- Reference.Adjust --
206	207	----------------------
207	208
208		- overriding
209	209	procedure Adjust (Object : in out Reference_Base) is
210	210	Internal_Access : Classwide_Access renames Object.Internal_Access;
211	211	begin

		@@ -218,17 +218,17 @@
218	218	-- Reference.Finalize --
219	219	------------------------
220	220
221		- overriding
222	221	procedure Finalize (Object : in out Reference_Base) is
223	222	Internal_Access : Classwide_Access renames Object.Internal_Access;
224	223	begin
225	224	if Internal_Access /= Null_Access then
226	225	declare
227	226	Upcasted : Types.Operations.Referenced_Access := Upcast (Internal_Access);
	227	+ bRelease : Boolean;
228	228	begin
229	229	Internal_Access := Null_Access;
230		-
231		- if Types.Operations.Release (Upcasted.all) then
	230	+ Types.Operations.Release (Upcasted.all, bRelease);
	231	+ if bRelease then
232	232	Referencing.Types.Operations.Free (Upcasted);
233	233	end if;
234	234	end;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.References.ads

--- a/Source/Referencing.References.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.References.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -16,6 +16,8 @@
16	16
17	17	with Referencing.Types;
18	18	with Ada.Finalization;
	19	+with System;
	20	+with Ada.Unchecked_Conversion;
19	21
20	22	with Referencing.Types.Operations;
21	23

		@@ -23,7 +25,7 @@
23	25	type Classwide_Access is private;
24	26	Null_Access : in Classwide_Access;
25	27	with function Upcast (Object : Classwide_Access) return Types.Operations.Referenced_Access is <>;
26		-package Referencing.References with Preelaborate is
	28	+package Referencing.References is
27	29
28	30	type Reference_Base is tagged private;
29	31

		@@ -35,58 +37,49 @@
35	37	type Reference is new Reference_Base with private;
36	38	package Operations is
37	39
38		- function Assigned
39		- (Object : Reference'Class)
40		- return Boolean
41		- with Inline_Always;
	40	+ type Reference_Ptr is access all Reference;
	41	+ function To_Pointer is
	42	+ new Ada.Unchecked_Conversion (System.Address, Reference_Ptr);
	43	+
	44	+ function Assigned (Object : Reference'Class) return Boolean;
42	45
43	46	procedure Assign
44	47	(Target : in out Reference'Class;
45		- Source : Reference'Class)
46		- with Inline_Always;
	48	+ Source : Reference'Class);
47	49
48	50	procedure Move
49	51	(Target : in out Reference'Class;
50		- Source : in out Reference'Class)
51		- with Inline_Always;
	52	+ Source : in out Reference'Class);
52	53
53		- function Get
54		- (Object : in Reference'Class)
55		- return Classwide_Access
56		- with Inline_Always;
	54	+ function Get (Object : in Reference'Class) return Classwide_Access;
57	55
58	56	procedure Set
59	57	(Object : in out Reference'Class;
60		- Item : Classwide_Access)
61		- with Inline_Always;
	58	+ Item : Classwide_Access);
62	59
63	60	procedure Set_And_Retain
64	61	(Object : in out Reference'Class;
65		- Item : Classwide_Access)
66		- with Inline_Always;
67		-
68		- -----------------------
69		- -- Limited_Reference --
70		- -----------------------
	62	+ Item : Classwide_Access);
71	63
72		- type Limited_Reference_Base
73		- (Data : not null access Reference) is
74		- limited private
75		- with Implicit_Dereference => Data;
	64	+ -------------------
	65	+ -- AUX_Reference --
	66	+ -------------------
	67	+
	68	+ type AUX_Reference_Base
	69	+ (Data : Reference_Ptr := null) is private;
76	70
77		- function Create_Limited_Reference
78		- return Limited_Reference_Base
79		- with Inline_Always;
	71	+ function Create_AUX_Reference return AUX_Reference_Base;
80	72
81		- function Create_And_Retain
82		- (Object : Classwide_Access)
83		- return Limited_Reference_Base
84		- with Inline_Always;
	73	+ function Create_And_Retain (Object : Classwide_Access)
	74	+ return AUX_Reference_Base;
	75	+
	76	+ pragma Inline_Always(Assigned, Assign, Move, Get, Set, Set_And_Retain,
	77	+ Create_AUX_Reference, Create_And_Retain);
85	78
86	79	private
87		- type Limited_Reference_Base
88		- (Data : not null access Reference) is
89		- limited record
	80	+ type AUX_Reference_Base
	81	+ (Data : Reference_Ptr := null) is
	82	+ record
90	83	Wrapped : aliased Reference;
91	84	end record;
92	85	end Operations;

		@@ -97,10 +90,10 @@
97	90	Internal_Access : Classwide_Access := Null_Access;
98	91	end record;
99	92
100		- overriding
101		- procedure Adjust (Object : in out Reference_Base) with Inline;
	93	+ procedure Adjust (Object : in out Reference_Base);
102	94
103		- overriding
104		- procedure Finalize (Object : in out Reference_Base) with Inline;
	95	+ procedure Finalize (Object : in out Reference_Base);
	96	+
	97	+ pragma Inline (Adjust, Finalize);
105	98
106	99	end Referencing.References;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.Types.Operations.Debug_Prints.adb

--- a/Source/Referencing.Types.Operations.Debug_Prints.adb Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.Types.Operations.Debug_Prints.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -14,7 +14,7 @@
14	14	-- limitations under the License. --
15	15	------------------------------------------------------------------------------
16	16
17		-with System.Atomic_Counters;
	17	+with Atomic_Counters;
18	18	with System.Address_Image;
19	19
20	20	with Referencing.Debug;

		@@ -27,7 +27,7 @@
27	27
28	28	function Is_Unique (Object : Referenced'Class) return Boolean is
29	29	begin
30		- return System.Atomic_Counters.Is_One (Object.Counter);
	30	+ return Atomic_Counters.Is_One (Object.Counter);
31	31	end Is_Unique;
32	32
33	33	------------

		@@ -39,19 +39,19 @@
39	39	begin
40	40	Referencing.Debug.Put_Line.all ("Retaining " & System.Address_Image (To_Address (Object'Unchecked_Access)));
41	41	exception when others => null; end;
42		- System.Atomic_Counters.Increment (Object.Counter);
	42	+ Atomic_Counters.Increment (Object.Counter);
43	43	end Retain;
44	44
45	45	-------------
46	46	-- Release --
47	47	-------------
48	48
49		- function Release (Object : in out Referenced'Class) return Boolean is
	49	+ procedure Release (Object : in out Referenced'Class; Result : out Boolean) is
50	50	begin
51	51	begin
52	52	Referencing.Debug.Put_Line.all ("Releasing " & System.Address_Image (To_Address (Object'Unchecked_Access)));
53	53	exception when others => null; end;
54		- return System.Atomic_Counters.Decrement (Object.Counter);
	54	+ Atomic_Counters.Decrement (Object.Counter, Result);
55	55	end Release;
56	56
57	57	end Referencing.Types.Operations;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.Types.Operations.adb

--- a/Source/Referencing.Types.Operations.adb Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.Types.Operations.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -14,7 +14,7 @@
14	14	-- limitations under the License. --
15	15	------------------------------------------------------------------------------
16	16
17		-with System.Atomic_Counters;
	17	+with Atomic_Counters;
18	18
19	19	package body Referencing.Types.Operations is
20	20

		@@ -24,7 +24,7 @@
24	24
25	25	function Is_Unique (Object : Referenced'Class) return Boolean is
26	26	begin
27		- return System.Atomic_Counters.Is_One (Object.Counter);
	27	+ return Atomic_Counters.Is_One (Object.Counter);
28	28	end Is_Unique;
29	29
30	30	------------

		@@ -33,16 +33,16 @@
33	33
34	34	procedure Retain (Object : in out Referenced'Class) is
35	35	begin
36		- System.Atomic_Counters.Increment (Object.Counter);
	36	+ Atomic_Counters.Increment (Object.Counter);
37	37	end Retain;
38	38
39	39	-------------
40	40	-- Release --
41	41	-------------
42	42
43		- function Release (Object : in out Referenced'Class) return Boolean is
	43	+ procedure Release (Object : in out Referenced'Class; Result : out Boolean) is
44	44	begin
45		- return System.Atomic_Counters.Decrement (Object.Counter);
	45	+ Atomic_Counters.Decrement (Object.Counter, Result);
46	46	end Release;
47	47
48	48	end Referencing.Types.Operations;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.Types.Operations.ads

--- a/Source/Referencing.Types.Operations.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.Types.Operations.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -15,20 +15,23 @@
15	15	------------------------------------------------------------------------------
16	16
17	17	with Ada.Unchecked_Deallocation;
18		-with System.Address_To_Access_Conversions;
	18	+with System;
	19	+with Ada.Unchecked_Conversion;
19	20
20		-package Referencing.Types.Operations with Preelaborate is
	21	+package Referencing.Types.Operations is
21	22
22		- package Conversions is new System.Address_To_Access_Conversions (Object => Referenced'Class);
23		- subtype Referenced_Access is Conversions.Object_Pointer;
	23	+ type Referenced_Access is access all Referenced'Class;
	24	+ function To_Access is
	25	+ new Ada.Unchecked_Conversion (System.Address, Referenced_Access);
24	26	procedure Free is new Ada.Unchecked_Deallocation (Object => Referenced'Class, Name => Referenced_Access);
25		- function To_Access (Value : System.Address) return Referenced_Access
26		- renames Conversions.To_Pointer;
27		- function To_Address (Value : Referenced_Access) return System.Address
28		- renames Conversions.To_Address;
	27	+ function To_Address is
	28	+ new Ada.Unchecked_Conversion (Referenced_Access, System.Address);
29	29
30		- function Is_Unique (Object : Referenced'Class) return Boolean with Inline_Always;
31		- procedure Retain (Object : in out Referenced'Class) with Inline_Always;
32		- function Release (Object : in out Referenced'Class) return Boolean with Inline_Always;
	30	+ function Is_Unique (Object : Referenced'Class) return Boolean;
	31	+ pragma Inline_Always(Is_Unique);
	32	+ procedure Retain (Object : in out Referenced'Class);
	33	+-- pragma Inline_Always(Retain);
	34	+ procedure Release (Object : in out Referenced'Class; Result : out Boolean);
	35	+-- pragma Inline_Always(Release);
33	36
34	37	end Referencing.Types.Operations;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.Types.ads

--- a/Source/Referencing.Types.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.Types.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -15,16 +15,16 @@
15	15	------------------------------------------------------------------------------
16	16
17	17	with Ada.Finalization;
18		-private with System.Atomic_Counters;
	18	+with Atomic_Counters;
19	19
20		-package Referencing.Types with Pure, Preelaborate is
	20	+package Referencing.Types is
21	21
22		- type Referenced is new Ada.Finalization.Limited_Controlled with private;
	22	+ type Referenced is new Ada.Finalization.Controlled with private;
23	23
24	24	private
25	25
26		- type Referenced is new Ada.Finalization.Limited_Controlled with record
27		- Counter : System.Atomic_Counters.Atomic_Counter;
	26	+ type Referenced is new Ada.Finalization.Controlled with record
	27	+ Counter : Atomic_Counters.Atomic_Counter;
28	28	end record;
29	29
30	30	end Referencing.Types;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Source/Referencing.ads

--- a/Source/Referencing.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Source/Referencing.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -16,13 +16,12 @@
16	16
17	17	with System.Storage_Elements;
18	18
19		-package Referencing with Pure, Preelaborate is
	19	+package Referencing is
20	20
21	21	private
22	22
23	23	Dummy_Structure : aliased constant array
24	24	(Positive range 1 .. 3) of
25		- System.Storage_Elements.Integer_Address :=
26		- (0, 0, 0);
	25	+ System.Storage_Elements.Integer_Address := (0, 0, 0);
27	26
28	27	end Referencing;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Tester/Output.txt

--- a/Tester/Output.txt Thu Jun 21 03:17:39 2018 +0200

+++ b/Tester/Output.txt Sun Sep 08 10:09:07 2019 +0400

		@@ -1,50 +1,71 @@
1		-gprbuild: "Referencing.Tester.exe" up to date
2		-Initializing 0000000000951020
3		-Creating 0000000000951020 with value 2
4		-Initializing 0000000000951050
5		-Creating 0000000000951050 with value 4
6		-Initializing 0000000000951080
7		-Creating 0000000000951080 with value 6
8		-begin
9		-Initializing 00000000009510B0
10		-Creating 00000000009510B0 with value 10
11		-Releasing 0000000000951050
12		-Finalizing 0000000000951050 with value 4
13		-------------------------
14		-Releasing 0000000000951020
15		-Finalizing 0000000000951020 with value 2
16		-Retaining 0000000000951080
17		----------- := ----------
18		-Initializing 0000000000951020
19		-Creating 0000000000951020 with value 12
20		-Releasing 0000000000951080
21		-Retaining 0000000000951020
22		-Releasing 0000000000951020
23		----------- := ----------
24		-...
25		-Initializing 0000000000951050
26		-Creating 0000000000951050 with value 24
27		-...
28		-Retaining 0000000000951050
29		-Releasing 0000000000951050
30		-Releasing 0000000000951020
31		-Finalizing 0000000000951020 with value 12
32		-Retaining 0000000000951050
33		-Releasing 0000000000951050
34		--------- Assign --------
35		-Initializing 0000000000951020
36		-Creating 0000000000951020 with value 48
37		-Releasing 0000000000951020
38		-Finalizing 0000000000951020 with value 48
39		---------- Move ---------
40		-Initializing 0000000000951020
41		-Creating 0000000000951020 with value 48
42		-Releasing 0000000000951050
43		-Finalizing 0000000000951050 with value 24
44		-end
45		-Releasing 0000000000951080
46		-Finalizing 0000000000951080 with value 6
47		-Releasing 00000000009510B0
48		-Finalizing 00000000009510B0 with value 10
49		-Releasing 0000000000951020
50		-Finalizing 0000000000951020 with value 48
	1	+Initializing 00000000001A13F0
	2	+Creating 00000000001A13F0 with value 2
	3	+Retaining 00000000001A13F0
	4	+Retaining 00000000001A13F0
	5	+Releasing 00000000001A13F0
	6	+Initializing 00000000001A1420
	7	+Creating 00000000001A1420 with value 4
	8	+Retaining 00000000001A1420
	9	+Retaining 00000000001A1420
	10	+Releasing 00000000001A1420
	11	+Initializing 00000000001A1470
	12	+Creating 00000000001A1470 with value 6
	13	+Retaining 00000000001A1470
	14	+Retaining 00000000001A1470
	15	+Releasing 00000000001A1470
	16	+begin
	17	+Initializing 00000000001A14A0
	18	+Creating 00000000001A14A0 with value 10
	19	+Retaining 00000000001A14A0
	20	+Retaining 00000000001A14A0
	21	+Releasing 00000000001A14A0
	22	+Releasing 00000000001A1420
	23	+------------------------
	24	+Releasing 00000000001A13F0
	25	+Retaining 00000000001A1470
	26	+---------- := ----------
	27	+Initializing 00000000001A14D0
	28	+Creating 00000000001A14D0 with value 12
	29	+Retaining 00000000001A14D0
	30	+Releasing 00000000001A1470
	31	+Retaining 00000000001A14D0
	32	+Releasing 00000000001A14D0
	33	+---------- := ----------
	34	+Initializing 00000000001A1550
	35	+Creating 00000000001A1550 with value 24
	36	+Retaining 00000000001A1550
	37	+Retaining 00000000001A1550
	38	+Releasing 00000000001A1550
	39	+...
	40	+...
	41	+Retaining 00000000001A1550
	42	+Releasing 00000000001A1550
	43	+Releasing 00000000001A14D0
	44	+Retaining 00000000001A1550
	45	+Releasing 00000000001A1550
	46	+-------- Assign --------
	47	+Initializing 00000000001A1580
	48	+Creating 00000000001A1580 with value 48
	49	+Retaining 00000000001A1580
	50	+Retaining 00000000001A1580
	51	+Releasing 00000000001A1550
	52	+Releasing 00000000001A1580
	53	+--------- Move ---------
	54	+Initializing 00000000001A15B0
	55	+Creating 00000000001A15B0 with value 96
	56	+Retaining 00000000001A15B0
	57	+Retaining 00000000001A15B0
	58	+Releasing 00000000001A15B0
	59	+Releasing 00000000001A1580
	60	+end
	61	+Releasing 00000000001A1470
	62	+Releasing 00000000001A14A0
	63	+Releasing 00000000001A15B0
	64	+Finalizing 00000000001A15B0 with value 96
	65	+Finalizing 00000000001A1580 with value 48
	66	+Finalizing 00000000001A1550 with value 24
	67	+Finalizing 00000000001A14D0 with value 12
	68	+Finalizing 00000000001A14A0 with value 10
	69	+Finalizing 00000000001A1470 with value 6
	70	+Finalizing 00000000001A1420 with value 4
	71	+Finalizing 00000000001A13F0 with value 2

diff -r 52ac65006ea3 -r 7ab19e93dc9d Tester/Referencing.Tester.Main.adb

--- a/Tester/Referencing.Tester.Main.adb Thu Jun 21 03:17:39 2018 +0200

+++ b/Tester/Referencing.Tester.Main.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -18,22 +18,25 @@
18	18
19	19	procedure Referencing.Tester.Main is
20	20
21		- Value_1 : Sample_Reference renames Create (2);
22		- Value_2 : Sample_Reference renames Create (4);
23		- Value_3 : Sample_Reference renames Plus (Value_1, Value_2);
	21	+ Value_1 : Sample_Reference := Create (2);
	22	+ Value_2 : Sample_Reference := Create (4);
	23	+ Value_3 : Sample_Reference := Plus (Value_1, Value_2);
	24	+ Source : Sample_Reference;
24	25
25	26	function Unlimited_Plus (Left, Right : Sample_Reference) return Sample_Reference is
	27	+ Result : Sample_Reference;
	28	+ Source : Sample_Reference := Plus (Left, Right);
26	29	begin
27		- return Result : Sample_Reference do
28		- Ada.Text_IO.Put_Line ("...");
29		- Result.Move (Plus (Left, Right));
30		- Ada.Text_IO.Put_Line ("...");
31		- end return;
	30	+ Ada.Text_IO.Put_Line ("...");
	31	+ Move (Result, Source);
	32	+ Ada.Text_IO.Put_Line ("...");
	33	+ return Result;
32	34	end Unlimited_Plus;
33	35
34	36	begin
35	37	Ada.Text_IO.Put_Line ("begin");
36		- Value_2.Move (Plus (Value_2, Value_3));
	38	+ Source := Plus (Value_2, Value_3);
	39	+ Move (Value_2, Source);
37	40	Ada.Text_IO.Put_Line ("------------------------");
38	41	Value_1 := Value_3;
39	42	Ada.Text_IO.Put_Line ("---------- := ----------");

		@@ -41,8 +44,9 @@
41	44	Ada.Text_IO.Put_Line ("---------- := ----------");
42	45	Value_1 := Unlimited_Plus (Value_1, Value_1);
43	46	Ada.Text_IO.Put_Line ("-------- Assign --------");
44		- Value_1.Assign (Plus (Value_1, Value_1));
	47	+ Assign (Value_1, Plus (Value_1, Value_1));
45	48	Ada.Text_IO.Put_Line ("--------- Move ---------");
46		- Value_1.Move (Plus (Value_1, Value_1));
	49	+ Source := Plus (Value_1, Value_1);
	50	+ Move (Value_1, Source);
47	51	Ada.Text_IO.Put_Line ("end");
48	52	end Referencing.Tester.Main;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Tester/Referencing.Tester.adb

--- a/Tester/Referencing.Tester.adb Thu Jun 21 03:17:39 2018 +0200

+++ b/Tester/Referencing.Tester.adb Sun Sep 08 10:09:07 2019 +0400

		@@ -27,20 +27,21 @@
27	27	-----------
28	28
29	29	function Image
30		- (Item : Referencing.Types.Operations.Referenced_Access)
31		- return String is
32		- (System.Address_Image
33		- (Referencing.Types.Operations.To_Address
34		- (Item)));
	30	+ (Item : Referencing.Types.Operations.Referenced_Access) return String is
	31	+ begin
	32	+ return System.Address_Image
	33	+ (Referencing.Types.Operations.To_Address (Item));
	34	+ end Image;
35	35
36	36	-------------------------------
37	37	-- Sample_Reference.Assigned --
38	38	-------------------------------
39	39
40	40	function Assigned
41		- (Object : Sample_Reference'Class)
42		- return Boolean is
43		- (Operations.Assigned (Object));
	41	+ (Object : Sample_Reference'Class) return Boolean is
	42	+ begin
	43	+ return Operations.Assigned (Object);
	44	+ end Assigned;
44	45
45	46	-----------------------------
46	47	-- Sample_Reference.Assign --

		@@ -68,33 +69,36 @@
68	69	-- Sample_Reference.Construct_Result --
69	70	---------------------------------------
70	71
71		- function Construct_Result
72		- return Sample_Limited_Reference is
73		- (Create_Limited_Reference);
	72	+ function Construct_Result return Sample_AUX_Reference is
	73	+ begin
	74	+ return Create_AUX_Reference;
	75	+ end Construct_Result;
74	76
75	77	-----------------------------
76	78	-- Sample_Reference.Create --
77	79	-----------------------------
78	80
79		- function Create
80		- (Value : Integer)
81		- return Sample_Limited_Reference is
	81	+ function Create (Value : Integer) return Sample_Reference is
	82	+ AUX_Reference_Var : Sample_AUX_Reference :=
	83	+ Create_AUX_Reference;
	84	+ Result_Ptr : Sample_Reference_Ptr :=
	85	+ To_Pointer (AUX_Reference_Var'Address);
82	86	begin
83		- return Result : Sample_Limited_Reference := Create_Limited_Reference do
84		- declare
85		- New_Object : not null Types.Sample_Access := new Types.Sample_Referenced;
86		- begin
87		- Operations.Set (Result, New_Object);
88		- Types.Create (New_Object, Value);
89		- end;
90		- end return;
	87	+ declare
	88	+ New_Object : Types.Sample_Access := new Types.Sample_Referenced;
	89	+ begin
	90	+ Operations.Set (Result_Ptr.all, New_Object);
	91	+ Types.Create (New_Object, Value);
	92	+ end;
	93	+ return Result_Ptr.all;
91	94	end Create;
92	95
93	96	---------------------------
94	97	-- Sample_Reference.Plus --
95	98	---------------------------
96	99
97		- function Plus (Left, Right : Sample_Reference'Class) return Sample_Limited_Reference is
	100	+ function Plus (Left, Right : Sample_Reference'Class)
	101	+ return Sample_Reference is
98	102	begin
99	103	return Types.Plus (Operations.Get (Left), Right);
100	104	end Plus;

		@@ -110,10 +114,11 @@
110	114	----------------------------
111	115
112	116	function Self
113		- (Object : access Sample_Referenced)
114		- return Sample_Limited_Reference is
115		- (Tester.Create_And_Retain (Object.all'Unchecked_Access))
116		- with Inline_Always;
	117	+ (Object : access Sample_Referenced) return Sample_AUX_Reference is
	118	+ begin
	119	+ return Tester.Create_And_Retain (Object.all'Unchecked_Access);
	120	+ end Self;
	121	+ pragma Inline_Always (Self);
117	122
118	123	------------------------------
119	124	-- Sample_Referenced.Create --

		@@ -137,8 +142,7 @@
137	142
138	143	function Plus
139	144	(Left : access Sample_Referenced;
140		- Right : Sample_Reference'Class)
141		- return Sample_Limited_Reference
	145	+ Right : Sample_Reference'Class) return Sample_Reference
142	146	is
143	147	Right_Access : constant Sample_Access := Operations.Get (Right);
144	148	begin

		@@ -149,25 +153,25 @@
149	153	-- Get --
150	154	---------
151	155
152		- function Get
153		- (Object : in Sample_Reference'Class)
154		- return Sample_Access is
155		- (Operations.Get (Object));
	156	+ function Get (Object : in Sample_Reference'Class) return Sample_Access is
	157	+ begin
	158	+ return Operations.Get (Object);
	159	+ end Get;
156	160
157	161	-----------------------
158	162	-- Create_And_Retain --
159	163	-----------------------
160	164
161	165	function Create_And_Retain
162		- (Object : Sample_Access)
163		- return Sample_Limited_Reference is
164		- (Tester.Create_And_Retain (Object));
	166	+ (Object : Sample_Access) return Sample_AUX_Reference is
	167	+ begin
	168	+ return Tester.Create_And_Retain (Object);
	169	+ end Create_And_Retain;
165	170
166	171	----------------------------------
167	172	-- Sample_Referenced.Initialize --
168	173	----------------------------------
169	174
170		- overriding
171	175	procedure Initialize (Object : in out Sample_Referenced) is
172	176	begin
173	177	declare

		@@ -186,7 +190,6 @@
186	190	-- Sample_Referenced.Finalize --
187	191	--------------------------------
188	192
189		- overriding
190	193	procedure Finalize (Object : in out Sample_Referenced) is
191	194	begin
192	195	begin

		@@ -210,8 +213,10 @@
210	213
211	214	function Upcast
212	215	(Object : Types.Sample_Access)
213		- return Referencing.Types.Operations.Referenced_Access is
214		- (Referencing.Types.Operations.Referenced_Access (Object));
	216	+ return Referencing.Types.Operations.Referenced_Access is
	217	+ begin
	218	+ return Referencing.Types.Operations.Referenced_Access (Object);
	219	+ end Upcast;
215	220
216	221	begin
217	222	Referencing.Debug.Put_Line := Ada.Text_IO.Put_Line'Access;

diff -r 52ac65006ea3 -r 7ab19e93dc9d Tester/Referencing.Tester.ads

--- a/Tester/Referencing.Tester.ads Thu Jun 21 03:17:39 2018 +0200

+++ b/Tester/Referencing.Tester.ads Sun Sep 08 10:09:07 2019 +0400

		@@ -17,6 +17,8 @@
17	17	with Referencing.Types;
18	18	with Referencing.References;
19	19	with Referencing.Types.Operations;
	20	+with System;
	21	+with Ada.Unchecked_Conversion;
20	22
21	23	package Referencing.Tester is
22	24

		@@ -28,39 +30,32 @@
28	30
29	31	Null_Sample_Reference : constant Sample_Reference;
30	32
31		- type Sample_Limited_Reference
32		- (Data : not null access Sample_Reference) is
33		- limited private
34		- with Implicit_Dereference => Data;
	33	+ type Sample_AUX_Reference is private;
	34	+-- with Implicit_Dereference => Data;
35	35
36	36	function Assigned
37	37	(Object : Sample_Reference'Class)
38		- return Boolean
39		- with Inline_Always;
	38	+ return Boolean;
	39	+ pragma Inline_Always (Assigned);
40	40
41	41	procedure Assign
42	42	(Target : in out Sample_Reference'Class;
43		- Source : Sample_Reference'Class)
44		- with Inline_Always;
	43	+ Source : Sample_Reference'Class);
	44	+ pragma Inline_Always (Assign);
45	45
46	46	procedure Move
47	47	(Target : in out Sample_Reference'Class;
48		- Source : in out Sample_Reference'Class)
49		- with Inline_Always;
	48	+ Source : in out Sample_Reference'Class);
	49	+ pragma Inline_Always (Move);
50	50
51	51	function Construct_Result
52		- return Sample_Limited_Reference
53		- with Inline_Always;
	52	+ return Sample_AUX_Reference;
	53	+ pragma Inline_Always (Construct_Result);
54	54
55		- function Create
56		- (Value : Integer)
57		- return Sample_Limited_Reference
58		- with Inline_Always;
	55	+ function Create (Value : Integer) return Sample_Reference;
59	56
60	57	function Plus
61		- (Left, Right : Sample_Reference'Class)
62		- return Sample_Limited_Reference
63		- with Inline_Always;
	58	+ (Left, Right : Sample_Reference'Class) return Sample_Reference;
64	59
65	60	-----------
66	61	-- Types --

		@@ -84,8 +79,7 @@
84	79
85	80	function Plus
86	81	(Left : access Sample_Referenced;
87		- Right : Sample_Reference'Class)
88		- return Sample_Limited_Reference;
	82	+ Right : Sample_Reference'Class) return Sample_Reference;
89	83
90	84	-------------------
91	85	-- Sample_Access --

		@@ -94,20 +88,17 @@
94	88	type Sample_Access is access all Sample_Referenced'Class;
95	89
96	90	function Get
97		- (Object : in Sample_Reference'Class)
98		- return Sample_Access
99		- with Inline_Always;
	91	+ (Object : in Sample_Reference'Class) return Sample_Access;
	92	+ pragma Inline_Always (Get);
100	93
101	94	function Create_And_Retain
102	95	(Object : Sample_Access)
103		- return Sample_Limited_Reference
104		- with Inline_Always;
	96	+ return Sample_AUX_Reference;
	97	+ pragma Inline_Always (Create_And_Retain);
105	98
106	99	private
107		- overriding
108	100	procedure Initialize (Object : in out Sample_Referenced);
109	101
110		- overriding
111	102	procedure Finalize (Object : in out Sample_Referenced);
112	103
113	104	package Sample_Referenced_Parents renames Referencing.Types;

		@@ -116,29 +107,23 @@
116	107
117	108	private
118	109
119		- function Upcast
120		- (Object : Types.Sample_Access)
121		- return Referencing.Types.Operations.Referenced_Access
122		- with Inline_Always;
	110	+ function Upcast (Object : Types.Sample_Access)
	111	+ return Referencing.Types.Operations.Referenced_Access;
	112	+ pragma Inline_Always (Upcast);
123	113
124		- package References is
125		- new Referencing.References
126		- (Types.Sample_Access, null);
	114	+ package References is new Referencing.References (Types.Sample_Access, null);
127	115
128		- type Sample_Reference is
129		- new References.Reference_Base
130		- with null record;
	116	+ type Sample_Reference is new References.Reference_Base with null record;
	117	+
	118	+ type Sample_Reference_Ptr is access all Sample_Reference;
	119	+ function To_Pointer is
	120	+ new Ada.Unchecked_Conversion (System.Address, Sample_Reference_Ptr);
131	121
132	122	Null_Sample_Reference : constant Sample_Reference :=
133	123	(References.Reference_Base with null record);
134	124
135		- package Operations is
136		- new References.Operations
137		- (Sample_Reference);
	125	+ package Operations is new References.Operations (Sample_Reference);
138	126
139		- type Sample_Limited_Reference
140		- (Data : not null access Sample_Reference) is
141		- new Operations.Limited_Reference_Base
142		- (Data => Data);
	127	+ type Sample_AUX_Reference is new Operations.AUX_Reference_Base;
143	128
144	129	end Referencing.Tester;

diff -r 52ac65006ea3 -r 7ab19e93dc9d build/build.txt

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

+++ b/build/build.txt Sun Sep 08 10:09:07 2019 +0400

		@@ -0,0 +1,19 @@
	1	+
	2	+-- ================================= Построение проекта Referencing.gpr ================================ --
	3	+
	4	+cd /d C:\ADAPROJECTS\AdaMagic
	5	+hg clone https://hg.osdn.net/view/referencing/Referencing
	6	+hg clone https://hg.osdn.net/view/referencing/Referencing Referencing.original
	7	+
	8	+cd /d C:\ADAPROJECTS\AdaMagic\Referencing
	9	+gprclean -f -r -PReferencing
	10	+gprclean -f -r -PReferencing_Tester
	11	+gprbuild -p Referencing.gpr
	12	+gprbuild -p Referencing_Tester.gpr
	13	+Tester\Referencing.Tester.exe
	14	+gprclean -f -r -PReferencing
	15	+gprclean -f -r -PReferencing_Tester
	16	+cd ..
	17	+bsdtar --create --file=Referencing.tar Referencing
	18	+xz -e --threads=0 Referencing.tar
	19	+

Show on old repository browser

referencing ForkReferencingFast_StringsAdaMagic_Experiments

Referencing: 提交

Commit MetaInfo

Log Message

更改概述

差异

referencing
Fork
Referencing
Fast_Strings
AdaMagic_Experiments