Ada-Ru Community

Анонс axmpp 0.0.1

Alexander Basov — Wed, 09 Mar 2011 17:14:32 +0000

Всем привет.
Хочу анонсировать первый релиз библиотеки AXMPP.

AXMPP – это реализация протокола XMPP для языка программирования Ада.
Это первый релиз библиотеки, которые включает в себя следующие возможности:
1. Поддержка безопасного соединения с помощью agnutsl (ada-binding для gnutls).
2. Реализация базовой части протокола XMPP:
* Управление списком контактов (ростер).
* Прием/отправка сообщений.
* Поддержка конференций.
* Поддержка информации о присутствии
* Возможности управления ресурсами.
* Возможность обработки/генерации IQ в сыром виде.
3. Поддержка расширения для получения информации о клиенте.

Ознакомиться с библиотекой, а также скачать исходники можно на сайте:

http://adaforge.qtada.com/cgi-bin/tracker.fcgi/axmpp

AXMPP распространяется под BSD подобной лицезией.

Типы данных с копированием-при-модификации (оптимизированный вариант)

Vadim Godunko — Thu, 30 Sep 2010 20:00:21 +0000

В прошлой статье была рассмотрена разработка типа данных с копированием-при-модификации, в этот же раз внимание будет уделено оптимизации реализации, в частности:

исключено выделение динамической памяти для “пустого” совместно используемого объекта;
в некоторых случаях исключено выделение динамической памяти для копии объекта при подготовке к модификации;
исключено выполнение дорогих операций атомарного инкремента/декремента при использовании “пустого” совместно используемого объекта;
обеспечена возможность категоризации пакета как Preelaborate, а типа данных как Preelaborable_Initialization.

Выделяемый при создании каждого объекта сегмент совместно используемой памяти всегда освобождается при установке значения или присваивании объекту значения другого объекта, т.е. фактически всегда он освобождается до использования. Поскольку операция выделения памяти в куче достаточно ресурсоёмкая, желательно исключить ненужные выделения/освобождения сегментов памяти. Сделать это можно разово выделив сегмент памяти для “пустого” совместно используемого объекта, например, при предысполнении спецификации пакета.

1
2
3
4
5
6
7

Empty_Shared : Shared_Data_Access := new Shared_Data;

type Holder is new Ada.Finalization.Controlled with record
Data : Shared_Data_Access := Empty_Shared;
end record;

overriding procedure Initialize (Self : in out Holder);

Для корректного подсчёта ссылок необходимо добавить подпрограмму Initialize, задача которой заключается в увеличении счётчика ссылок при инициализации объекта по умолчанию.

1
2
3
4

procedure Initialize (Self : in out Holder) is
begin
Reference (Self.Data);
end Initialize;

Использование разово выделенного при предысполнении сегмента памяти имеет оборотную сторону — пакет более не может быть классифицирован как Preelaborate, а тип данных как Preelaborable_Initialization. Столь жесткая классификация пакета и типа может быть полезна в некоторых применениях (например, при использовании средств распределённых вычислений). Исправить ситуацию возможно за счёт отказа от распределения “пустого” совместно используемого сегмента памяти в динамической памяти и распределении его статически.

1
2
3
4
5

Empty_Shared : aliased Shared_Data := (others => <>);

type Holder is new Ada.Finalization.Controlled with record
Data : Shared_Data_Access := Empty_Shared'Access;
end record;

При этом необходимо исключить выполнение освобождения статически выделенного сегмента памяти в подпрограмме Unreference:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

procedure Unreference (Self : in out Shared_Data_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Shared_Data, Shared_Data_Access);
begin
if Counters.Decrement (Self.Counter'Access) then
if Self /= Empty_Shared'Access then
Free (Self);
else
Self := null;
end if;
else
Self := null;
end if;
end Unreference;

Фактически же получается, что значение счётчика статически распределённого сегмента не представляет никакого интереса. Поскольку операции атомарного инкремента/декремента значительно более ресурсоёмки нежели проверка значения и переход, вполне логично полностью отказаться от поддержания значения счётчика для статически выделенного сегмента в актуальном состоянии, для чего можно переписать реализацию Reference и Unreference (обратите внимание на использование короткозамкнутой формы логических операций, гарантирующей последовательность вычисления предикатов):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

procedure Reference (Self : not null Shared_Data_Access) is
begin
if Self /= Empty_Shared'Access then
Counters.Increment (Self.Counter);
end if;
end Reference;

procedure Unreference (Self : in out Shared_Data_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Shared_Data, Shared_Data_Access);
begin
if Self /= Empty_Shared'Access
and then Counters.Decrement (Self.Counter'Access)
then
Free (Self);
else
Self := null;
end if;
end Unreference;

Теперь обратив внимание на выделение динамической памяти при подготовке к модификации значения в подпрограмме Detach. Сейчас подготовка к модификации заключается в выделении нового сегмента для совместно используемого объекта в динамической памяти. Однако, если значение счётчика равно единице, то такое выделение не имеет смысла, поскольку старый объект будет освобождён непоследственно после копирования значения; а следовательно можно использовать старый объект, не только исключив выделение динамической памяти, но и сэкономив на выполнении копирования данных. Отметим, что подготавливаемый к модификации объект не должен быть статически выделенным “пустым” объектом, в противном случае всё же необходимо выделение нового объекта.

1
2
3
4
5
6
7
8
9
10

procedure Detach (Self : in out not null Shared_Data_Access) is
Old : Shared_Data_Access := Self;
begin
if Self = Empty_Shared'Access
or else not Counters.Is_One (Self.Counter)
then
Self := new Shared_Data'(Counter => <>, Value => Old.Value);
Unreference (Old);
end if;
end Detach;

Теперь пришло время привести полный исходные текст спецификации и реализации пакета.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

private with Ada.Finalization;
private with Counters;

generic
type T is private;
package Holders is
pragma Preelaborate;

type Holder is private;
pragma Preelaborable_Initialization (Holder);

Empty : constant Holder;

procedure Set (Self : in out Holder; Value : T);
function Get (Self : Holder) return T;

private

type Shared_Data is record
Counter : aliased Counters.Counter;
Value : T;
end record;

type Shared_Data_Access is access all Shared_Data;

procedure Reference (Self : not null Shared_Data_Access);
procedure Unreference (Self : in out Shared_Data_Access);
procedure Detach (Self : in out not null Shared_Data_Access);

Empty_Shared : aliased Shared_Data := (others => <>);

type Holder is new Ada.Finalization.Controlled with record
Data : Shared_Data_Access := Empty_Shared'Access;
end record;

overriding procedure Adjust (Self : in out Holder);
overriding procedure Finalize (Self : in out Holder);

Empty : constant Holder
:= (Ada.Finalization.Controlled with others => <>);
end Holders;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

with Ada.Unchecked_Deallocation;

package body Holders is

------------
-- Adjust --
------------

overriding procedure Adjust (Self : in out Holder) is
begin
Reference (Self.Data);
end Adjust;

------------
-- Detach --
------------

procedure Detach (Self : in out not null Shared_Data_Access) is
Old : Shared_Data_Access := Self;
begin
if Self = Empty_Shared'Access
or else not Counters.Is_One (Self.Counter)
then
Self := new Shared_Data'(Counter => <>, Value => Old.Value);
Unreference (Old);
end if;
end Detach;

--------------
-- Finalize --
--------------

overriding procedure Finalize (Self : in out Holder) is
begin
if Self.Data /= null then
Unreference (Self.Data);
end if;
end Finalize;

---------
-- Get --
---------

function Get (Self : Holder) return T is
begin
return Self.Data.Value;
end Get;

---------------
-- Reference --
---------------

procedure Reference (Self : not null Shared_Data_Access) is
begin
if Self /= Empty_Shared'Access then
Counters.Increment (Self.Counter);
end if;
end Reference;

---------
-- Set --
---------

procedure Set (Self : in out Holder; Value : T) is
begin
Detach (Self.Data);
Self.Data.Value := Value;
end Set;

-----------------
-- Unreference --
-----------------

procedure Unreference (Self : in out Shared_Data_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Shared_Data, Shared_Data_Access);
begin
if Self /= Empty_Shared'Access
and then Counters.Decrement (Self.Counter'Access)
then
Free (Self);
else
Self := null;
end if;
end Unreference;

end Holders;

И дать ссылку на архив исходных текстов [download id="3"].

QtAda: Как подавить предупреждения компилятора о неизвестных прагмах Q_Slot и Q_Signal

Vadim Godunko — Thu, 23 Sep 2010 20:00:02 +0000

При компиляции программ, использующих QtAda нередко встречаются диагностические сообщения компилятора о неизвестных прагмах Q_Slot и Q_Signal. Эти прагмы предназначены для компилятора метаинформации, а соответствующие предупреждения компилятора не являются актуальными; более того, они не позволяют использовать режим компилятора при котором любые предупреждения рассматриваются как ошибки.

Простейшим способом подавления этих предупреждений является отключение предупреждений перед прагмами Q_Slot и Q_Signal и включение предупреждений сразу же после прагм. Для этого возможно использовать прагму Warnings:

1
2
3
4
5
6
7
8
9

procedure My_Slot (Self : not null access My_Widget'Class);
pragma Warnings (Off);
pragma Q_Slot (My_Slot);
pragma Warnings (On);

procedure My_Signal (Self : not null access My_Widget'Class);
pragma Warnings (Off);
pragma Q_Signal (My_Signal);
pragma Warnings (On);

Серьёзным недостатком этого способа является нарушение читаемости кода за счёт наличия дополнительных прагм. При использовании компилятора GNAT GPL 2010 можно использовать особую форму прагмы Warnings, позволяющую отключить не все, а только конкретные предупреждения. В этом случае в контексте пакета можно написать:

1
2
3
4

pragma Warnings (Off, "unrecognized pragma ""Q_Slot""");
pragma Warnings (Off, "unrecognized pragma ""Q_Signal""");

package My_Widgets is

Этот способ подходит для приложений в которых не используется большое количество собственных классов объектов, в противном случае указанные прагмы необходимо включать в любой пакет где объявляется порождённый от Q_Object тип, что тоже не очень приятно. Поэтому пожалуй самым интересным является глобальное отключение этих предупреждений с использованием файла конфигурации. Для этого необходимо создать файл конфигурации, например qtada.adc, следующего содержания:

1 2	pragma Warnings (Off, "unrecognized pragma ""Q_Slot"""); pragma Warnings (Off, "unrecognized pragma ""Q_Signal""");

Теперь осталось проинструктировать копилятор о необходимости использования файла конфигурации. Это возможно сделать с помошью ключа -gnatec=qtada.adc (если вызов компилятора выполняется напрямую) или же просто добавив атрибут Global_Configuration_Pragmas пакета Builder в файл проекта:

1
2
3

package Builder is
for Global_Configuration_Pragmas use "qtada.adc";
end Builder;

Типы данных с копированием-при-модификации (простой вариант)

Vadim Godunko — Thu, 16 Sep 2010 20:00:53 +0000

Типы данных с копированием-при-модификации находят широкое применение в современной программной индустрии с целью упрощения управления и минимизации объёма использованной динамической памяти. Менее известными, но подчас более важными свойствами таких типов данных является константное время выполнения операции присваивания и использование небольшого и независящего от фактического размера данных объёма памяти стэка, используемой для объектов.

Для реализации обычно используется технология неявного совместного использования данных, когда объект хранит только ссылку на сегмент совместно используемых данных, а управление освобождением сегмента совместно используемых данных осуществляется с использованием счётчика ссылок. В общем случае эта технология имеет одно важное ограничение, не позволяющее активно использовать её в Ada программах — сегмент совместно используемых данных не должен использоваться более чем одной задачей. Для снятия этого ограничения достаточно защитить счётчик ссылок от одновременного доступа несколькими задачами. В предыдущей статье обуждался вопрос эффективной реализации атомарного счётчика ссылок с достаточной степенью переносимости, что даёт возможность создания эффективной реализации типов данных с копированием-при-модификации.

В качестве примера будем рассматривать упрощённый аналог стандартного контейнера Ada.Containers.Holders, предназначенный для хранения одного значения определённого при настройке типа данных. Для хранения данных будем использовать структуру данных, состоящую из двух полей: атомарного счётчика ссылок и значения. Над ссылочным типом на эту структуру необходимо иметь три базовые операции:

Reference, увеличивающую счётчик ссылок на единицу;
Unreference, уменьшающую счётчик ссылок на единицу и освобождающую совместно используемый объект при достижении счётчиком нулевого значения;
Detach, выполняющую создание копии объекта для последующей модификации.

1
2
3
4
5
6
7
8
9
10

type Shared_Data is record
Counter : aliased Counters.Counter;
Value : T;
end record;

type Shared_Data_Access is access all Shared_Data;

procedure Reference (Self : not null Shared_Data_Access);
procedure Unreference (Self : in out Shared_Data_Access);
procedure Detach (Self : in out not null Shared_Data_Access);

Реализация подпрограммы Reference содержит исключительно вызов подпрограммы увеличения значения счётчика. Для исключения необходимости проверки факта переполнения счётчика предполагается, что он способен хранить достаточно большое значение достигнуть которое невозможно:

1
2
3
4

procedure Reference (Self : not null Shared_Data_Access) is
begin
Counters.Increment (Self.Counter);
end Reference;

Реализация подпрограммы Unreference вызывает функцию декремента значения счётчика и освобождает задействованный под совместно используемые данные сегмент при достижении счётчиком нулевого значения; в противном случае она просто сбрасывает переданный указатель на значение null (то же самое делает и вызов функции Free):

1
2
3
4
5
6
7
8
9
10
11

procedure Unreference (Self : in out Shared_Data_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Shared_Data, Shared_Data_Access);
begin
if Counters.Decrement (Self.Counter'Access) then
Free (Self);

else
Self := null;
end if;
end Unreference;

Подпрограмму Detach можно реализовать весьма просто, как создание нового объекта совместно используемых данных с инициализацией имеющимся значением:

1
2
3
4
5
6

procedure Detach (Self : in out not null Shared_Data_Access) is
Old : Shared_Data_Access := Self;
begin
Self := new Shared_Data'(Counter => <>, Value => Old.Value);
Unreference (Old);
end Detach;

Интерфейс настраиваемого пакета состоит из типа-контейнера, константы этого типа, представляющей “пустое” значение и подпрограмм для установки и получения значения; тип-контейнер является контролируемым и для него переопределяются стандартные подпрограммы Adjust (копирование) и Finalize (деструктор):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

Тип Holder содержит одно единственное поле – ссылку на совместно испольуемый объект данных. Это поле автоматически инициализируется при создании объекта типа Holder ссылкой на выделенный совместно используемый объект. Поскольку, согласно соглашению, счётчик автоматически инициализируется значением 1 нет необходимости увеличивать его значение и переопределять подпрограмму Initialize.

Подпрограмма Adjust выполняет вызов описанной выше подпрограммы Reference:

1
2
3
4

overriding procedure Adjust (Self : in out Holder) is
begin
Reference (Self.Data);
end Adjust;

Подпрограмма Finalize выполняет вызов подпрограммы Unreference, но необходимо помнить, что язык позволяет осуществлять вызов этой подпрограммы многократно (что имеет место быть в условиях хитросплетённых ситуаций очистки при выявлении непредвиденного поведения программы), поэтому перед вызовом Unreference внутренняя ссылка проверяется на ненулевое значение (значение указателя сбрасывается в null при выполнении подпрограммы Unreference):

1
2
3
4
5
6

overriding procedure Finalize (Self : in out Holder) is
begin
if Self.Data /= null then
Unreference (Self.Data);
end if;
end Finalize;

Подпрограмма Get возвращает хранящееся в совместно используемом объекте значение.

1
2
3
4

function Get (Self : Holder) return T is
begin
return Self.Data.Value;
end Get;

Подпрограмма Set устанавливает значение внутри совместно используемого объекта, но перед этим выполняет вызов подпрограммы Detach для создания собственной копии данных.

1
2
3
4
5

procedure Set (Self : in out Holder; Value : T) is
begin
Detach (Self.Data);
Self.Data.Value := Value;
end Set;

Как видно из примера, шаблон реализации типов с копированием-при-модификации достаточно прост. Отметим, что рассмотренная реализация может быть усовершенствована для повышения производительности, эффективности использования памяти, возможности использования в пакетах категории Preelaborate, а в некоторых случаях и для использования Preelaborable_Initialization типов. Вопросы возможной оптимизации будут рассмотрены в следующей статье.

В заключение приводится полный исходный текст примера:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

private with Ada.Finalization;
private with Counters;

generic
type T is private;

package Holders is

type Holder is private;
Empty : constant Holder;

procedure Set (Self : in out Holder; Value : T);
function Get (Self : Holder) return T;

private

type Shared_Data is record
Counter : aliased Counters.Counter;
Value : T;
end record;

type Shared_Data_Access is access all Shared_Data;

procedure Reference (Self : not null Shared_Data_Access);
procedure Unreference (Self : in out Shared_Data_Access);
procedure Detach (Self : in out not null Shared_Data_Access);

type Holder is new Ada.Finalization.Controlled with record
Data : Shared_Data_Access := new Shared_Data;
end record;

overriding procedure Adjust (Self : in out Holder);
overriding procedure Finalize (Self : in out Holder);

Empty : constant Holder
:= (Ada.Finalization.Controlled with others => <>);
end Holders;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

with Ada.Unchecked_Deallocation;

package body Holders is

------------
-- Adjust --
------------

overriding procedure Adjust (Self : in out Holder) is
begin
Reference (Self.Data);
end Adjust;

------------
-- Detach --
------------

procedure Detach (Self : in out not null Shared_Data_Access) is
Old : Shared_Data_Access := Self;
begin
Self := new Shared_Data'(Counter => <>, Value => Old.Value);
Unreference (Old);
end Detach;

--------------
-- Finalize --
--------------

overriding procedure Finalize (Self : in out Holder) is
begin
if Self.Data /= null then
Unreference (Self.Data);
end if;
end Finalize;

---------
-- Get --
---------

function Get (Self : Holder) return T is
begin
return Self.Data.Value;
end Get;

---------------
-- Reference --
---------------

procedure Reference (Self : not null Shared_Data_Access) is
begin
Counters.Increment (Self.Counter);
end Reference;

---------
-- Set --
---------

procedure Set (Self : in out Holder; Value : T) is
begin
Detach (Self.Data);
Self.Data.Value := Value;
end Set;

-----------------
-- Unreference --
-----------------

procedure Unreference (Self : in out Shared_Data_Access) is
procedure Free is
new Ada.Unchecked_Deallocation (Shared_Data, Shared_Data_Access);
begin
if Counters.Decrement (Self.Counter'Access) then
Free (Self);
else
Self := null;
end if;
end Unreference;

end Holders;

Полный комплект исходных текстов можно скачать по ссылке [download id="2"].

Портируемая реализация атомарного счётчика

Vadim Godunko — Fri, 10 Sep 2010 20:00:54 +0000

Для решения некоторых задач на современных многопроцессорных и многоядерных вычислительных машинах требуются счётчики, значение которых может увеличиваться и уменьшаться одновременно из нескольких задач, при этом не разрушая значения и не затирая изменённое другой задачей значение.

В качестве примера будем рассматривать тип данных-счётчик, инициализируемый начальным значением 1, и три операции над ним:

Increment — увеличивает значение счётчика на единицу;
Decrement — уменьшает значение счётчика на единицу, возвращает True если значение достигло нуля, в противном случае возвращает False;
Is_One — проверяет текущее значение счётчика, возвращает True если оно равно единице, в противном случае возвращает False.

Поставленная задача может быть решена встроенными средствами языка, например так:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

with Interfaces;

package Counters is

type Counter is limited private;

procedure Increment (Self : in out Counter);

function Decrement (Self : not null access Counter) return Boolean;

function Is_One (Self : Counter) return Boolean;

private

protected type Counter is
procedure Increment;
procedure Decrement (Is_Zero : out Boolean);
function Is_One return Boolean;
private
Value : Interfaces.Unsigned_32 := 1;
end Counter;

end Counters;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

package body Counters is

use type Interfaces.Unsigned_32;

-------------
-- Counter --
-------------

protected body Counter is

---------------
-- Decrement --
---------------

procedure Decrement (Is_Zero : out Boolean) is
begin
Value := Value - 1;
Is_Zero := Value = 0;
end Decrement;

---------------
-- Increment --
---------------

procedure Increment is
begin
Value := Value + 1;
end Increment;

------------
-- Is_One --
------------

function Is_One return Boolean is
begin
return Value = 1;
end Is_One;

end Counter;

---------------
-- Decrement --
---------------

function Decrement (Self : not null access Counter) return Boolean is
Is_Zero : Boolean;

begin
Self.Decrement (Is_Zero);

return Is_Zero;
end Decrement;

---------------
-- Increment --
---------------

procedure Increment (Self : in out Counter) is
begin
Self.Increment;
end Increment;

------------
-- Is_One --
------------

function Is_One (Self : Counter) return Boolean is
begin
return Self.Is_One;
end Is_One;

end Counters;

В этом варианте реализации для защиты текущего значения счётчика используется защищённый тип. Это пожалуй самый портируемый вариант решения, однако обладающий серьёзным недостатком – низкой эффективностью, поскольку реализация защищённых типов как правило использует механизмы межпроцессного взаимодействия.

Значительно интереснее было бы использовать аппаратную поддержку операций атомарного инкремента/декремента, присутствующую в большинстве современных процессоров. Это, однако, требует включения в код ассемблерных вставок, что приводит к невозможности легкого портирования кода. Тем не менее, пользователи компилятора GNAT имеют возможность использовать встроенные функции GCC для выполнения атомарных операций инкремента/декремента. Их использование не делает код портируемым между GNAT-ом и другим компилятором, но позволяет использовать его на большом количестве современных процессоров (среди которых Alpha, IA64, PowerPC, SPARC V9, X86-64).

Семейство встроенных функций GCC для инкремента именуется как __sync_add_and_fetch_X, а для декремента значения как __sync_sub_and_fetch_X, где X – размер операнда в байтах. В Ada эти операции могут быть импортированы с указанием соглашения Intrinsic:

1
2
3
4
5
6
7
8
9
10
11

procedure Sync_Add_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32);
pragma Import
(Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");

function Sync_Sub_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
pragma Import
(Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");

Использование встроенных функций требует особого внимания к некоторым аспектам объявления и использования переменной-счётчика. Это затрагивает:

выравнивания объекта в памяти — некоторые процессоры накладывают жесткие ограничения на выравнивание данных в памяти и неспособны выполнить операции чтения/записи невыровненных данных;
обеспечения доступа к значению одной неразрывной операцией — необходимо гарантировать, что процессор способен выполнять чтение/запись одной неразрывной операцией, в противном случае возможно получение некорректных данных при чтении или искажение данных при записи;
предотвращения оптимизации кода сохранением значения в регистрах и последующим его использованием. ;

Стандартные средства языка Ada предоставляют портируемые способы решения этих задач:

для обеспечения корректного выравнивания объекта в памяти достаточно объявить переменную как aliased;
проверка поддержки неразрывного доступа к значению и использование соответствующих операций гарантируется использованием прагмы Atomic;
оптимизация кода путём сохранения ранее прочитанного значения в регистрах отключается применение прагмы Volatile;

Прежде чем показать полный код реализации полезно обратить внимание на один небольшой момент — приватный тип Counter объявлен как запись с одним компонентом для хранения значения. Это необходимо для гарантии корректного выравнивания, и снятия с пользователя необходимости контроля за выравниванием объектов Counter; а так же для обеспечения возможности начальной инициализации значения счётчика.

А теперь приведём полный код реализации:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

with Interfaces;

package Counters is

type Counter is limited private;

procedure Increment (Self : in out Counter);
pragma Inline (Increment);

function Decrement (Self : not null access Counter) return Boolean;
pragma Inline (Decrement);

function Is_One (Self : Counter) return Boolean;
pragma Inline (Is_One);

private

type Counter is record
Value : aliased Interfaces.Unsigned_32 := 1;
pragma Atomic (Value);
pragma Volatile (Value);
end record;

end Counters;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

package body Counters is

use type Interfaces.Unsigned_32;

procedure Sync_Add_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32);
pragma Import
(Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");

function Sync_Sub_And_Fetch
(Ptr : access Interfaces.Unsigned_32;
Value : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
pragma Import
(Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");

---------------
-- Decrement --
---------------

function Decrement (Self : not null access Counter) return Boolean is
begin
return Sync_Sub_And_Fetch (Self.Value'Access, 1) = 0;
end Decrement;

---------------
-- Increment --
---------------

procedure Increment (Self : in out Counter) is
begin
Sync_Add_And_Fetch (Self.Value'Access, 1);
end Increment;

------------
-- Is_One --
------------

function Is_One (Self : Counter) return Boolean is
begin
return Self.Value = 1;
end Is_One;

end Counters;

Приведённая реализация с использованием встроенных функций GCC будет успешно работать при использовании компилятора GNAT GPL 2009 и выше. При компиляции кода для процессора x86 в 32-битном режиме необходимо активировать режим генерации кода для процессора 80486 и выше (указав в ключ компилятора -march=i486, хотя в общем случае можно порекомендовать использовать ключ -march=i686).

Для особо пытливых приводятся фрагменты кода подпрограммы Decrement для процессоров x86_64 и SPARC V9 соответственно:

1
2
3
4
5
6

counters__decrement:
movl $-1, %eax
lock xaddl %eax, (%rdi)
cmpl $1, %eax
sete %al
ret

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

counters__decrement:
lduw [%o0], %g2
.LL11:
mov %g2, %g1
add %g2, -1, %g3
membar 15
mov %g3, %g4
cas [%o0], %g2, %g4
cmp %g4, %g1
bne,pt %icc, .LL11
mov %g4, %g2
subcc %g0, %g3, %g0
subx %g0, -1, %o0
jmp %o7+8
nop

Полный исходный текст примеров можно скачать по ссылке [download id="1"].