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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
with Ada.Unchecked_Deallocation;
with System.Address_To_Access_Conversions;
package body Preference_Arrays is
type Ranking is range 1 .. 255;
type Preference_Array is array (Positive range <>, Positive range <>) of Ranking;
pragma Pack (Preference_Array);
-- these following functions would be a lot smaller and neater
-- if the FFI could make use of fat pointers
function Create_Preference_Array
(Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int)
return System.Address
is
subtype Constrained is Preference_Array
(1 .. Positive (Number_Of_Ballots),
1 .. Positive (Size_Of_Ballot));
package Convert is new System.Address_To_Access_Conversions
(Object => Constrained);
Pref_Array : Convert.Object_Pointer;
begin
Pref_Array := new Preference_Array
(1 .. Positive (Number_Of_Ballots),
1 .. Positive (Size_Of_Ballot));
return Convert.To_Address (Pref_Array);
end Create_Preference_Array;
procedure Free_Preference_Array
(Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int;
Pref_Array_Address : in System.Address)
is
subtype Constrained is Preference_Array
(1 .. Positive (Number_Of_Ballots),
1 .. Positive (Size_Of_Ballot));
package Convert is new System.Address_To_Access_Conversions
(Object => Constrained);
procedure Free_Pref_Array is new Ada.Unchecked_Deallocation
(Object => Constrained, Name => Convert.Object_Pointer);
Pref_Array : Convert.Object_Pointer;
begin
Pref_Array := Convert.To_Pointer (Pref_Array_Address);
Free_Pref_Array (Pref_Array);
end Free_Preference_Array;
procedure Poke_Preference_Array
(Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int;
Pref_Array_Address : in System.Address;
Ballot_Index, Box_Number, Rank : in Interfaces.C.int)
is
subtype Constrained is Preference_Array
(1 .. Positive (Number_Of_Ballots),
1 .. Positive (Size_Of_Ballot));
package Convert is new System.Address_To_Access_Conversions
(Object => Constrained);
Pref_Array : Convert.Object_Pointer;
begin
Pref_Array := Convert.To_Pointer (Pref_Array_Address);
Pref_Array (Positive (Ballot_Index), Positive (Box_Number)) := Ranking (Rank);
end Poke_Preference_Array;
function Peek_Preference_Array
(Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int;
Pref_Array_Address : in System.Address;
Ballot_Index, Box_Number, Rank : in Interfaces.C.int)
return Interfaces.C.int
is
subtype Constrained is Preference_Array
(1 .. Positive (Number_Of_Ballots),
1 .. Positive (Size_Of_Ballot));
package Convert is new System.Address_To_Access_Conversions
(Object => Constrained);
Pref_Array : Convert.Object_Pointer;
begin
Pref_Array := Convert.To_Pointer (Pref_Array_Address);
if Pref_Array (Positive (Ballot_Index), Positive (Box_Number)) = Ranking (Rank) then
return 1;
else
return 0;
end if;
end Peek_Preference_Array;
end Preference_Arrays;
|
