Skip to content

Commit fa9749f

Browse files
RoldakRoldak
committed
Add initial support for compute shaders.
1 parent bc4f75e commit fa9749f

12 files changed

+722
-389
lines changed

‎opengl/src/generated/gl-api.ads

+262-253
Large diffs are not rendered by default.

‎opengl/src/generated/gl-load_function_pointers.adb

+139-133
Large diffs are not rendered by default.

‎opengl/src/implementation/gl-compute.adb

+48
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
-- part of OpenGLAda, (c) 2022 Felix Krause
2+
-- released under the terms of the MIT license, see the file "COPYING"
3+
4+
with GL.Enums.Getter;
5+
with GL.API;
6+
7+
package body GL.Compute is
8+
function Max_Compute_Work_Group_Count (Index : Index_Type) return Int is
9+
Value : aliased Int;
10+
begin
11+
API.Get_Integer_Indexed
12+
(GL.Enums.Getter.Max_Compute_Work_Group_Count,
13+
Index_Type'Pos (Index),
14+
Value'Access);
15+
Raise_Exception_On_OpenGL_Error;
16+
return Value;
17+
end Max_Compute_Work_Group_Count;
18+
19+
function Max_Compute_Work_Group_Size (Index : Index_Type) return Int is
20+
Value : aliased Int;
21+
begin
22+
API.Get_Integer_Indexed
23+
(GL.Enums.Getter.Max_Compute_Work_Group_Size,
24+
Index_Type'Pos (Index),
25+
Value'Access);
26+
Raise_Exception_On_OpenGL_Error;
27+
return Value;
28+
end Max_Compute_Work_Group_Size;
29+
30+
function Max_Compute_Work_Group_Invocations return Int is
31+
Value : aliased Int;
32+
begin
33+
API.Get_Integer
34+
(GL.Enums.Getter.Max_Compute_Work_Group_Invocations,
35+
Value'Access);
36+
Raise_Exception_On_OpenGL_Error;
37+
return Value;
38+
end Max_Compute_Work_Group_Invocations;
39+
40+
procedure Dispatch_Compute
41+
(Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt) is
42+
begin
43+
API.Dispatch_Compute (Num_Groups_X, Num_Groups_Y, Num_Groups_Z);
44+
Raise_Exception_On_OpenGL_Error;
45+
end Dispatch_Compute;
46+
end GL.Compute;
47+
48+

‎opengl/src/implementation/gl-enums-getter.ads

+6
Original file line numberDiff line numberDiff line change
@@ -248,9 +248,12 @@ package GL.Enums.Getter is
248248
Stencil_Back_Ref,
249249
Stencil_Back_Value_Mask,
250250
Stencil_Back_Writemask,
251+
Max_Compute_Work_Group_Invocations,
251252
Max_Debug_Message_Length,
252253
Max_Debug_Logged_Messages,
253254
Debug_Logged_Messages,
255+
Max_Compute_Work_Group_Count,
256+
Max_Compute_Work_Group_Size,
254257
Max_Framebuffer_Width,
255258
Max_Framebuffer_Height,
256259
Max_Framebuffer_Layers,
@@ -497,9 +500,12 @@ package GL.Enums.Getter is
497500
Stencil_Back_Ref => 16#8CA3#,
498501
Stencil_Back_Value_Mask => 16#8CA4#,
499502
Stencil_Back_Writemask => 16#8CA5#,
503+
Max_Compute_Work_Group_Invocations => 16#90EB#,
500504
Max_Debug_Message_Length => 16#9143#,
501505
Max_Debug_Logged_Messages => 16#9144#,
502506
Debug_Logged_Messages => 16#9145#,
507+
Max_Compute_Work_Group_Count => 16#91BE#,
508+
Max_Compute_Work_Group_Size => 16#91BF#,
503509
Max_Framebuffer_Width => 16#9315#,
504510
Max_Framebuffer_Height => 16#9316#,
505511
Max_Framebuffer_Layers => 16#9317#,

‎opengl/src/implementation/gl-memory_barriers.adb

+17
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
-- part of OpenGLAda, (c) 2022 Felix Krause
2+
-- released under the terms of the MIT license, see the file "COPYING"
3+
4+
with Ada.Unchecked_Conversion;
5+
6+
with GL.API;
7+
8+
package body GL.Memory_Barriers is
9+
procedure Memory_Barrier (Bits : Barrier_Bits) is
10+
function To_BitField is new Ada.Unchecked_Conversion
11+
(Barrier_Bits, GL.Low_Level.Bitfield);
12+
begin
13+
API.Memory_Barrier (To_BitField (Bits));
14+
Raise_Exception_On_OpenGL_Error;
15+
end Memory_Barrier;
16+
end GL.Memory_Barriers;
17+

‎opengl/src/interface/gl-compute.ads

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
-- part of OpenGLAda, (c) 2022 Felix Krause
2+
-- released under the terms of the MIT license, see the file "COPYING"
3+
4+
with GL.Types;
5+
6+
package GL.Compute is
7+
pragma Preelaborate;
8+
9+
use GL.Types;
10+
11+
type Index_Type is (X, Y, Z);
12+
13+
function Max_Compute_Work_Group_Count (Index : Index_Type) return Int;
14+
function Max_Compute_Work_Group_Size (Index : Index_Type) return Int;
15+
function Max_Compute_Work_Group_Invocations return Int;
16+
17+
procedure Dispatch_Compute
18+
(Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt);
19+
20+
private
21+
for Index_Type use (X => 0, Y => 1, Z => 2);
22+
end GL.Compute;
23+

‎opengl/src/interface/gl-memory_barriers.ads

+56
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
-- part of OpenGLAda, (c) 2022 Felix Krause
2+
-- released under the terms of the MIT license, see the file "COPYING"
3+
4+
private with GL.Low_Level;
5+
6+
package GL.Memory_Barriers is
7+
pragma Preelaborate;
8+
9+
type Barrier_Bits is record
10+
Vertex_Attrib_Array : Boolean := False;
11+
Element_Array : Boolean := False;
12+
Uniform : Boolean := False;
13+
Texture_Fetch : Boolean := False;
14+
15+
Shader_Image_Access : Boolean := False;
16+
Command : Boolean := False;
17+
Pixel_Buffer : Boolean := False;
18+
Texture_Update : Boolean := False;
19+
Buffer_Update : Boolean := False;
20+
Framebuffer : Boolean := False;
21+
Transform_Feedback : Boolean := False;
22+
Atomic_Counter : Boolean := False;
23+
Shader_Storage : Boolean := False;
24+
Client_Mapped_Buffer : Boolean := False;
25+
Query_Buffer : Boolean := False;
26+
27+
Unused : Boolean := False;
28+
end record;
29+
pragma Convention (C, Barrier_Bits);
30+
31+
procedure Memory_Barrier (Bits : Barrier_Bits);
32+
33+
private
34+
for Barrier_Bits use record
35+
Vertex_Attrib_Array at 0 range 0 .. 0;
36+
Element_Array at 0 range 1 .. 1;
37+
Uniform at 0 range 2 .. 2;
38+
Texture_Fetch at 0 range 3 .. 3;
39+
40+
Shader_Image_Access at 0 range 5 .. 5;
41+
Command at 0 range 6 .. 6;
42+
Pixel_Buffer at 0 range 7 .. 7;
43+
Texture_Update at 0 range 8 .. 8;
44+
Buffer_Update at 0 range 9 .. 9;
45+
Framebuffer at 0 range 10 .. 10;
46+
Transform_Feedback at 0 range 11 .. 11;
47+
Atomic_Counter at 0 range 12 .. 12;
48+
Shader_Storage at 0 range 13 .. 13;
49+
Client_Mapped_Buffer at 0 range 14 .. 14;
50+
Query_Buffer at 0 range 15 .. 15;
51+
52+
Unused at 0 range 16 .. 31;
53+
end record;
54+
for Barrier_Bits'Size use Low_Level.Bitfield'Size;
55+
end GL.Memory_Barriers;
56+

‎opengl/src/interface/gl-objects-shaders.ads

+4-2
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,8 @@ package GL.Objects.Shaders is
77
pragma Preelaborate;
88

99
type Shader_Type is (Fragment_Shader, Vertex_Shader, Geometry_Shader,
10-
Tess_Evaluation_Shader, Tess_Control_Shader);
10+
Tess_Evaluation_Shader, Tess_Control_Shader,
11+
Compute_Shader);
1112

1213
type Shader (Kind : Shader_Type) is new GL_Object with private;
1314

@@ -39,7 +40,8 @@ private
3940
Vertex_Shader => 16#8B31#,
4041
Geometry_Shader => 16#8DD9#,
4142
Tess_Evaluation_Shader => 16#8E87#,
42-
Tess_Control_Shader => 16#8E88#);
43+
Tess_Control_Shader => 16#8E88#,
44+
Compute_Shader => 16#91B9#);
4345
for Shader_Type'Size use Low_Level.Enum'Size;
4446

4547
end GL.Objects.Shaders;

‎opengl/src/specs/gl-api.spec

+16
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,10 @@ spec GL.API is
103103
Static => "glGetFloatv";
104104
procedure Get_Integer (Name : Enums.Getter.Parameter;
105105
Target : access Int) with Static => "glGetIntegerv";
106+
procedure Get_Integer_Indexed (Name : Enums.Getter.Parameter;
107+
Index : UInt;
108+
Target : access Int) with
109+
Dynamic => "glGetIntegeri_v";
106110
procedure Get_Int_Vec4 (Name : Enums.Getter.Parameter;
107111
Target : in out Ints.Vector4) with
108112
Static => "glGetIntegerv";
@@ -1300,4 +1304,16 @@ spec GL.API is
13001304
Static => "glDepthRange", Wrapper => "GL.Window.Set_Depth_Range";
13011305
procedure Viewport (X, Y : Int; Width, Height : Size) with
13021306
Static => "glViewport", Wrapper => "GL.Window.Set_Viewport";
1307+
1308+
-----------------------------------------------------------------------------
1309+
-- Compute Shaders --
1310+
-----------------------------------------------------------------------------
1311+
1312+
procedure Dispatch_Compute
1313+
(Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt) with
1314+
Dynamic => "glDispatchCompute",
1315+
Wrapper => "GL.Compute.Dispatch_Compute";
1316+
procedure Memory_Barrier (Bits : Low_Level.Bitfield) with
1317+
Dynamic => "glMemoryBarrier",
1318+
Wrapper => "GL.Memory_Barriers.Memory_Barrier";
13031319
end GL.API;

‎tests/opengl-test.gpr

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ project OpenGL.Test is
1111

1212
for Main use ("gl_test-vbos", "gl_test-immediate", "gl_test-shaders",
1313
"gl_test-opengl3", "gl_test-context", "gl_test-framebuffers",
14-
"gl_test-debugging");
14+
"gl_test-debugging", "gl_test-compute");
1515

1616
package Ide renames OpenGL.Ide;
1717
package Builder renames OpenGL.Builder;

‎tests/src/gl/gl_test-compute-shader.glsl

+10
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
#version 430
2+
layout(local_size_x = 32) in;
3+
layout(std430, binding = 0) buffer data {
4+
float values[];
5+
};
6+
7+
void main() {
8+
int x = int(gl_GlobalInvocationID.x);
9+
values[x] = 2 * values[x];
10+
}

‎tests/src/gl/gl_test-compute.adb

+140
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,140 @@
1+
-- part of OpenGLAda, (c) 2022 Felix Krause
2+
-- released under the terms of the MIT license, see the file "COPYING"
3+
4+
with Ada.Text_IO;
5+
6+
with GL.Compute;
7+
with GL.Files;
8+
with GL.Memory_Barriers;
9+
with GL.Objects.Buffers;
10+
with GL.Objects.Shaders;
11+
with GL.Objects.Programs;
12+
with GL.Types;
13+
14+
with GL_Test.Display_Backend;
15+
16+
procedure GL_Test.Compute is
17+
use GL.Types;
18+
19+
procedure Load_Singles is new GL.Objects.Buffers.Load_To_Buffer
20+
(Single_Pointers);
21+
22+
procedure Map_Singles is new GL.Objects.Buffers.Map
23+
(Single_Pointers);
24+
25+
Data_Count : constant := 1024;
26+
27+
Iteration_Count : Natural := 0;
28+
29+
Buffer : GL.Objects.Buffers.Buffer;
30+
Invalid : GL.Objects.Buffers.Buffer;
31+
Compute_Shader : GL.Objects.Shaders.Shader
32+
(Kind => GL.Objects.Shaders.Compute_Shader);
33+
Program : GL.Objects.Programs.Program;
34+
begin
35+
Display_Backend.Init;
36+
Display_Backend.Open_Window (Width => 500, Height => 500);
37+
38+
Buffer.Initialize_Id;
39+
Invalid.Initialize_Id;
40+
Compute_Shader.Initialize_Id;
41+
Program.Initialize_Id;
42+
43+
-- initialize an SSBO with numbers from 1 to `Data_Count`
44+
declare
45+
use GL.Objects.Buffers;
46+
47+
Values : Single_Array (1 .. Data_Count);
48+
begin
49+
for I In Values'Range loop
50+
Values (I) := Single (I);
51+
end loop;
52+
Shader_Storage_Buffer.Bind (Buffer);
53+
Load_Singles
54+
(Shader_Storage_Buffer,
55+
Values,
56+
Dynamic_Draw);
57+
-- The following dummy bind is necessary for the Bind_Buffer_Base
58+
-- to be effective. TODO: determine if it's a bug or not.
59+
Shader_Storage_Buffer.Bind (Invalid);
60+
Shader_Storage_Buffer.Bind_Buffer_Base (0, Buffer);
61+
end;
62+
63+
-- load shader sources and compile shaders
64+
GL.Files.Load_Shader_Source_From_File
65+
(Compute_Shader, "../src/gl/gl_test-compute-shader.glsl");
66+
67+
Compute_Shader.Compile;
68+
69+
if not Compute_Shader.Compile_Status then
70+
Ada.Text_IO.Put_Line ("Compilation of compute shader failed. log:");
71+
Ada.Text_IO.Put_Line (Compute_Shader.Info_Log);
72+
end if;
73+
74+
-- set up program
75+
Program.Attach (Compute_Shader);
76+
Program.Link;
77+
if not Program.Link_Status then
78+
Ada.Text_IO.Put_Line ("Program linking failed. Log:");
79+
Ada.Text_IO.Put_Line (Program.Info_Log);
80+
return;
81+
end if;
82+
83+
-- check various constant
84+
declare
85+
use GL.Compute;
86+
begin
87+
for Index in Index_Type loop
88+
Ada.Text_IO.Put ("Max compute work group count " & Index'Image & " :");
89+
Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Count (Index)));
90+
end loop;
91+
92+
for Index in Index_Type loop
93+
Ada.Text_IO.Put ("Max compute work group size " & Index'Image & " :");
94+
Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Size (Index)));
95+
end loop;
96+
97+
Ada.Text_IO.Put ("Max compute work group invocations :");
98+
Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Invocations));
99+
end;
100+
101+
Program.Use_Program;
102+
103+
-- dispatch compute shader 5 times
104+
while Iteration_Count < 5 loop
105+
-- local size for x axis is 32 as specified in the shader
106+
GL.Compute.Dispatch_Compute (Data_Count / 32, 1, 1);
107+
GL.Memory_Barriers.Memory_Barrier
108+
((Shader_Storage => True, others => False));
109+
Iteration_Count := Iteration_Count + 1;
110+
end loop;
111+
112+
-- print the final result to compare to the expected value
113+
declare
114+
use GL.Objects;
115+
use GL.Objects.Buffers;
116+
117+
CPU_Total : Single := 0.0;
118+
GPU_Total : Single := 0.0;
119+
120+
Value_Ptr : Single_Pointers.Pointer;
121+
begin
122+
Map_Singles (Shader_Storage_Buffer, Read_Only, Value_Ptr);
123+
124+
for I in 1 .. Data_Count loop
125+
-- We run 5 iterations of the compute shader which simply doubles its
126+
-- previous value, so this is ultimately the same as multiplying the
127+
-- initial value by 2 ** 5 = 32.
128+
CPU_Total := CPU_Total + Single (I) * 32.0;
129+
GPU_Total := GPU_Total + Value_Ptr.all;
130+
Single_Pointers.Increment (Value_Ptr);
131+
end loop;
132+
133+
Unmap (Shader_Storage_Buffer);
134+
135+
Ada.Text_IO.Put_Line ("CPU Total : " & CPU_Total'Image);
136+
Ada.Text_IO.Put_Line ("GPU Total : " & GPU_Total'Image);
137+
end;
138+
139+
Display_Backend.Shutdown;
140+
end GL_Test.Compute;

0 commit comments

Comments
 (0)