Skip to content

Commit 9454722

Browse files
committed
Merge branch 'slides/add-advanced-resources-management' into 'master'
Slides on Advanced Resources Management Closes #204 See merge request feng/training/material!286
2 parents da54107 + 3c95702 commit 9454722

File tree

13 files changed

+1200
-1
lines changed

13 files changed

+1200
-1
lines changed

courses/fundamentals_of_ada/030_basic_types/11-subtypes_full_picture.rst

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -181,6 +181,35 @@ Attributes Reflect the Underlying Type
181181
Shade : Color range Red .. Blue := Brown; -- run-time error
182182
Hue : Rainbow := Rainbow'Succ (Blue); -- run-time error
183183
184+
---------------
185+
Valid attribute
186+
---------------
187+
188+
* :ada:`The_Type'Valid` is a :ada:`Boolean`
189+
* :ada:`True` |rightarrow| the current representation for the given scalar is valid
190+
191+
.. code:: Ada
192+
193+
procedure Main is
194+
subtype Small_T is Integer range 1 .. 3;
195+
Big : aliased Integer := 0;
196+
Small : Small_T with Address => Big'Address;
197+
begin
198+
for V in 0 .. 5 loop
199+
Big := V;
200+
Put_Line (Big'Image & " => " & Boolean'Image (Small'Valid));
201+
end loop;
202+
end Main;
203+
204+
.. code::
205+
206+
0 => FALSE
207+
1 => TRUE
208+
2 => TRUE
209+
3 => TRUE
210+
4 => FALSE
211+
5 => FALSE
212+
184213
------------------------
185214
Idiom: Extended Ranges
186215
------------------------

courses/fundamentals_of_ada/140_access_types-in_depth.rst

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,5 +57,6 @@ Access Types In Depth
5757
.. include:: 140_access_types/08-memory_management.rst
5858
.. include:: 140_access_types/09-memory_debugging.rst
5959
.. include:: 140_access_types/10-memory_control.rst
60+
.. include:: 140_access_types/11-type_safe_idioms.rst
6061
.. include:: labs/140_access_types-in_depth.lab.rst
6162
.. include:: 140_access_types/99-summary_with_pools.rst

courses/fundamentals_of_ada/140_access_types/10-memory_control.rst

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,4 +123,3 @@ System.Storage_Pools Example (Partial)
123123
end if;
124124
end loop;
125125
end Deallocate;
126-
Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
===========================
2+
Advanced Access Type Safety
3+
===========================
4+
5+
-----------------------------------
6+
Elaboration-Only Dynamic Allocation
7+
-----------------------------------
8+
9+
* Common in critical contexts
10+
* Rationale:
11+
12+
1. We (might) need dynamically allocated date
13+
14+
- e.g. loading configuration data of unknown size
15+
16+
2. Deallocations can cause leaks, corruption
17+
18+
- |rightarrow| **Disallow** them entirely
19+
20+
3. A dynamically allocated object will need deallocation
21+
22+
- |rightarrow| Unless it never goes out of **scope**
23+
24+
* |rightarrow| Allow only allocation onto globals
25+
26+
.. tip::
27+
28+
And restrict allocations to program elaboration
29+
30+
--------------------------
31+
Prevent Heap Deallocations
32+
--------------------------
33+
34+
* :ada:`Ada.Unchecked_Deallocation` cannot be used anymore
35+
* No heap deallocation is possible
36+
37+
- The total number of allocations should be bounded
38+
- e.g. elaboration-only allocations
39+
40+
.. code:: Ada
41+
42+
pragma Restrictions
43+
(No_Dependence => Unchecked_Deallocation);
44+
45+
--------------------------------
46+
Constant Access at Library Level
47+
--------------------------------
48+
49+
.. code:: Ada
50+
51+
type Acc is access T;
52+
procedure Free is new Ada.Unchecked_Deallocation (T, Acc);
53+
54+
A : constant Acc := new T;
55+
56+
* :ada:`A` is :ada:`constant`
57+
58+
* Cannot be deallocated
59+
60+
-------------------------------
61+
Constant Access as Discriminant
62+
-------------------------------
63+
64+
.. code:: Ada
65+
66+
type R (A : access T) is limited record
67+
68+
* :ada:`A` is :ada:`constant`
69+
70+
* Cannot be deallocated
71+
72+
* :ada:`R` is :ada:`limited`
73+
74+
* Cannot be copied
75+
76+
------------------------
77+
Idiom: Access to Subtype
78+
------------------------
79+
80+
.. tip::
81+
82+
:ada:`subtype` improves access-related code safety
83+
84+
* Subtype constraints still apply through the access type
85+
86+
.. code:: Ada
87+
88+
type Values_T is array (Positive range <>) of Integer;
89+
subtype Two_Values_T is Values_T (1 .. 2);
90+
type Two_Values_A is access all Two_Values_T;
91+
92+
function Get return Values_T is (1 => 10);
93+
94+
-- O : aliased Two_Values_T := Get;
95+
-- Runtime FAIL: Constraint check
96+
O : aliased Values_T := Get; -- Single value, bounds are 1 .. 1
97+
-- P : Two_Values_A := O'Access;
98+
-- Compile-time FAIL: Bounds must statically match
Lines changed: 151 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
==========================================
2+
Refcounting Wrapper for External C Objects
3+
==========================================
4+
5+
-------
6+
Context
7+
-------
8+
9+
* From :url:`https://blog.adacore.com/the-road-to-a-thick-opengl-binding-for-ada-part-2`
10+
* OpenGL API create various objects like textures or vertex buffers
11+
* Creating them gives us an ID
12+
13+
- Can then be used to refer to the object
14+
15+
* Simple approach: Manually reclaiming them
16+
17+
- Could cause leaks
18+
19+
* Refcount approach: automatic ID management
20+
21+
- From an Ada wrapper
22+
- Automatic reclaim once the last reference vanishes
23+
24+
-----------------
25+
Wrapper Interface
26+
-----------------
27+
28+
* :ada:`type GL_Object is abstract tagged private`
29+
30+
- Implements smart pointer logic
31+
32+
.. code:: Ada
33+
34+
procedure Initialize_Id (Object : in out GL_Object);
35+
36+
procedure Clear (Object : in out GL_Object);
37+
38+
function Initialized (Object : GL_Object) return Boolean;
39+
40+
* Derived by the **actual** object types
41+
42+
.. code:: Ada
43+
44+
procedure Internal_Create_Id
45+
(Object : GL_Object; Id : out UInt) is abstract;
46+
47+
procedure Internal_Release_Id
48+
(Object : GL_Object; Id : UInt) is abstract;
49+
50+
* Example usage
51+
52+
.. code:: Ada
53+
54+
type Shader (Kind : Shader_Type) is new GL_Object with null record;
55+
56+
------------------------------------
57+
Wrapper Implementation: Private part
58+
------------------------------------
59+
60+
* Object ID's holder: :ada:`GL_Object_Reference`
61+
62+
- All derived types have a handle to this
63+
64+
.. code:: Ada
65+
66+
type GL_Object_Reference;
67+
type GL_Object_Reference_Access is access all GL_Object_Reference;
68+
69+
type GL_Object is abstract new Ada.Finalization.Controlled
70+
with record
71+
Reference : GL_Object_Reference_Access := null;
72+
end record;
73+
74+
* Controlled type implementing **ref-counting**
75+
76+
.. code:: Ada
77+
78+
overriding procedure Adjust (Object : in out GL_Object);
79+
-- Increases reference count.
80+
81+
overriding procedure Finalize (Object : in out GL_Object);
82+
-- Decreases reference count.
83+
-- Destroys underlying resource when it reaches zero.
84+
85+
------------------------------------
86+
Wrapper Implementation: Full Picture
87+
------------------------------------
88+
89+
.. image:: controlled_gl_object.svg
90+
91+
.. code:: Ada
92+
93+
type GL_Object_Reference is record
94+
GL_Id : UInt;
95+
Reference_Count : Natural;
96+
Is_Owner : Boolean;
97+
end record;
98+
99+
------------------------
100+
:ada:`Adjust` Completion
101+
------------------------
102+
103+
* :ada:`Adjust` is called every time a new reference is **created**
104+
* Increments the ref-counter
105+
106+
.. code:: Ada
107+
108+
overriding procedure Adjust (Object : in out GL_Object) is
109+
begin
110+
if Object.Reference /= null then
111+
Object.Reference.Reference_Count := @ + 1;
112+
end if;
113+
end Adjust;
114+
115+
--------------------------
116+
:ada:`Finalize` Completion
117+
--------------------------
118+
119+
.. note::
120+
121+
* :ada:`Finalize` should always be :dfn:`idempotent`
122+
123+
- Compiler might call it multiple times on the same object
124+
- In particular when **exceptions** occur
125+
126+
.. code:: Ada
127+
128+
overriding procedure Finalize (Object : in out GL_Object) is
129+
Ref : GL_Object_Reference_Access
130+
renames Object.Reference;
131+
begin
132+
133+
134+
.. warning::
135+
136+
Do **not** decrement the reference counter for every call
137+
138+
* A given object will own **only one** reference
139+
140+
.. code:: Ada
141+
142+
-- Idempotence: the next call to Finalize will have no effect
143+
Ref := null;
144+
145+
if Ref /= null then
146+
Ref.Reference_Count := @ - 1;
147+
if Ref.Reference_Count = 0 then
148+
Free (Ref.all); -- Call to user-defined primitive
149+
Unchecked_Free (Ref);
150+
end if;
151+
end if;

courses/fundamentals_of_ada/240_tasking/05-task_types_in_depth.rst

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -158,6 +158,40 @@ Protected Object Entries
158158
...
159159
end Object;
160160
161+
-------------------------------------
162+
Discriminated Protected or Task types
163+
-------------------------------------
164+
165+
* Discriminant can be an :ada:`access` or discrete type
166+
* Resulting type is indefinite
167+
168+
- Unless mutable
169+
170+
* Example: counter shared between tasks
171+
172+
.. code:: Ada
173+
174+
protected type Counter_T is
175+
procedure Increment;
176+
end Counter_T
177+
178+
task type My_Task (Counter : not null access Counter_T) is [...]
179+
180+
task body My_Task is
181+
begin
182+
Counter.Increment;
183+
[...]
184+
185+
----------------------------------------
186+
Using discriminant for Real-Time aspects
187+
----------------------------------------
188+
189+
.. code:: Ada
190+
191+
protected type Protected_With_Priority (Prio : System.Priority)
192+
with Priority => Prio
193+
is
194+
161195
------------------------------------------
162196
Example: Protected Objects - Declaration
163197
------------------------------------------

0 commit comments

Comments
 (0)