Add initial support for compute shaders.

Roldak · Roldak · commit fa9749f77a78 · 2022-03-06T19:12:17.000+01:00
diff --git a/opengl/src/generated/gl-api.ads b/opengl/src/generated/gl-api.ads
diff --git a/opengl/src/generated/gl-load_function_pointers.adb b/opengl/src/generated/gl-load_function_pointers.adb
diff --git a/opengl/src/implementation/gl-compute.adb b/opengl/src/implementation/gl-compute.adb
@@ -0,0 +1,48 @@
+--  part of OpenGLAda, (c) 2022 Felix Krause
+--  released under the terms of the MIT license, see the file "COPYING"
+
+with GL.Enums.Getter;
+with GL.API;
+
+package body GL.Compute is
+   function Max_Compute_Work_Group_Count (Index : Index_Type) return Int is
+      Value : aliased Int;
+   begin
+      API.Get_Integer_Indexed
+        (GL.Enums.Getter.Max_Compute_Work_Group_Count,
+         Index_Type'Pos (Index),
+         Value'Access);
+      Raise_Exception_On_OpenGL_Error;
+      return Value;
+   end Max_Compute_Work_Group_Count;
+
+   function Max_Compute_Work_Group_Size (Index : Index_Type) return Int is
+      Value : aliased Int;
+   begin
+      API.Get_Integer_Indexed
+        (GL.Enums.Getter.Max_Compute_Work_Group_Size,
+         Index_Type'Pos (Index),
+         Value'Access);
+      Raise_Exception_On_OpenGL_Error;
+      return Value;
+   end Max_Compute_Work_Group_Size;
+
+   function Max_Compute_Work_Group_Invocations return Int is
+      Value : aliased Int;
+   begin
+      API.Get_Integer
+        (GL.Enums.Getter.Max_Compute_Work_Group_Invocations,
+         Value'Access);
+      Raise_Exception_On_OpenGL_Error;
+      return Value;
+   end Max_Compute_Work_Group_Invocations;
+
+   procedure Dispatch_Compute
+     (Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt) is
+   begin
+      API.Dispatch_Compute (Num_Groups_X, Num_Groups_Y, Num_Groups_Z);
+      Raise_Exception_On_OpenGL_Error;
+   end Dispatch_Compute;
+end GL.Compute;
+
+
diff --git a/opengl/src/implementation/gl-enums-getter.ads b/opengl/src/implementation/gl-enums-getter.ads
@@ -248,9 +248,12 @@ package GL.Enums.Getter is
       Stencil_Back_Ref,
       Stencil_Back_Value_Mask,
       Stencil_Back_Writemask,
+      Max_Compute_Work_Group_Invocations,
       Max_Debug_Message_Length,
       Max_Debug_Logged_Messages,
       Debug_Logged_Messages,
+      Max_Compute_Work_Group_Count,
+      Max_Compute_Work_Group_Size,
       Max_Framebuffer_Width,
       Max_Framebuffer_Height,
       Max_Framebuffer_Layers,
@@ -497,9 +500,12 @@ package GL.Enums.Getter is
       Stencil_Back_Ref              => 16#8CA3#,
       Stencil_Back_Value_Mask       => 16#8CA4#,
       Stencil_Back_Writemask        => 16#8CA5#,
+      Max_Compute_Work_Group_Invocations => 16#90EB#,
       Max_Debug_Message_Length      => 16#9143#,
       Max_Debug_Logged_Messages     => 16#9144#,
       Debug_Logged_Messages         => 16#9145#,
+      Max_Compute_Work_Group_Count  => 16#91BE#,
+      Max_Compute_Work_Group_Size   => 16#91BF#,
       Max_Framebuffer_Width         => 16#9315#,
       Max_Framebuffer_Height        => 16#9316#,
       Max_Framebuffer_Layers        => 16#9317#,
diff --git a/opengl/src/implementation/gl-memory_barriers.adb b/opengl/src/implementation/gl-memory_barriers.adb
@@ -0,0 +1,17 @@
+--  part of OpenGLAda, (c) 2022 Felix Krause
+--  released under the terms of the MIT license, see the file "COPYING"
+
+with Ada.Unchecked_Conversion;
+
+with GL.API;
+
+package body GL.Memory_Barriers is
+   procedure Memory_Barrier (Bits : Barrier_Bits) is
+      function To_BitField is new Ada.Unchecked_Conversion
+        (Barrier_Bits, GL.Low_Level.Bitfield);
+   begin
+      API.Memory_Barrier (To_BitField (Bits));
+      Raise_Exception_On_OpenGL_Error;
+   end Memory_Barrier;
+end GL.Memory_Barriers;
+
diff --git a/opengl/src/interface/gl-compute.ads b/opengl/src/interface/gl-compute.ads
@@ -0,0 +1,23 @@
+--  part of OpenGLAda, (c) 2022 Felix Krause
+--  released under the terms of the MIT license, see the file "COPYING"
+
+with GL.Types;
+
+package GL.Compute is
+   pragma Preelaborate;
+
+   use GL.Types;
+
+   type Index_Type is (X, Y, Z);
+
+   function Max_Compute_Work_Group_Count (Index : Index_Type) return Int;
+   function Max_Compute_Work_Group_Size (Index : Index_Type) return Int;
+   function Max_Compute_Work_Group_Invocations return Int;
+
+   procedure Dispatch_Compute
+     (Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt);
+
+private
+   for Index_Type use (X => 0, Y => 1, Z => 2);
+end GL.Compute;
+
diff --git a/opengl/src/interface/gl-memory_barriers.ads b/opengl/src/interface/gl-memory_barriers.ads
@@ -0,0 +1,56 @@
+--  part of OpenGLAda, (c) 2022 Felix Krause
+--  released under the terms of the MIT license, see the file "COPYING"
+
+private with GL.Low_Level;
+
+package GL.Memory_Barriers is
+   pragma Preelaborate;
+
+   type Barrier_Bits is record
+      Vertex_Attrib_Array  : Boolean := False;
+      Element_Array        : Boolean := False;
+      Uniform              : Boolean := False;
+      Texture_Fetch        : Boolean := False;
+
+      Shader_Image_Access  : Boolean := False;
+      Command              : Boolean := False;
+      Pixel_Buffer         : Boolean := False;
+      Texture_Update       : Boolean := False;
+      Buffer_Update        : Boolean := False;
+      Framebuffer          : Boolean := False;
+      Transform_Feedback   : Boolean := False;
+      Atomic_Counter       : Boolean := False;
+      Shader_Storage       : Boolean := False;
+      Client_Mapped_Buffer : Boolean := False;
+      Query_Buffer         : Boolean := False;
+
+      Unused               : Boolean := False;
+   end record;
+   pragma Convention (C, Barrier_Bits);
+
+   procedure Memory_Barrier (Bits : Barrier_Bits);
+
+private
+   for Barrier_Bits use record
+      Vertex_Attrib_Array  at 0 range 0 .. 0;
+      Element_Array        at 0 range 1 .. 1;
+      Uniform              at 0 range 2 .. 2;
+      Texture_Fetch        at 0 range 3 .. 3;
+
+      Shader_Image_Access  at 0 range 5 .. 5;
+      Command              at 0 range 6 .. 6;
+      Pixel_Buffer         at 0 range 7 .. 7;
+      Texture_Update       at 0 range 8 .. 8;
+      Buffer_Update        at 0 range 9 .. 9;
+      Framebuffer          at 0 range 10 .. 10;
+      Transform_Feedback   at 0 range 11 .. 11;
+      Atomic_Counter       at 0 range 12 .. 12;
+      Shader_Storage       at 0 range 13 .. 13;
+      Client_Mapped_Buffer at 0 range 14 .. 14;
+      Query_Buffer         at 0 range 15 .. 15;
+
+      Unused               at 0 range 16 .. 31;
+   end record;
+   for Barrier_Bits'Size use Low_Level.Bitfield'Size;
+end GL.Memory_Barriers;
+
diff --git a/opengl/src/interface/gl-objects-shaders.ads b/opengl/src/interface/gl-objects-shaders.ads
@@ -7,7 +7,8 @@ package GL.Objects.Shaders is
    pragma Preelaborate;
 
    type Shader_Type is (Fragment_Shader, Vertex_Shader, Geometry_Shader,
-                        Tess_Evaluation_Shader, Tess_Control_Shader);
+                        Tess_Evaluation_Shader, Tess_Control_Shader,
+                        Compute_Shader);
 
    type Shader (Kind : Shader_Type) is new GL_Object with private;
 
@@ -39,7 +40,8 @@ private
                         Vertex_Shader          => 16#8B31#,
                         Geometry_Shader        => 16#8DD9#,
                         Tess_Evaluation_Shader => 16#8E87#,
-                        Tess_Control_Shader    => 16#8E88#);
+                        Tess_Control_Shader    => 16#8E88#,
+                        Compute_Shader         => 16#91B9#);
    for Shader_Type'Size use Low_Level.Enum'Size;
 
 end GL.Objects.Shaders;
diff --git a/opengl/src/specs/gl-api.spec b/opengl/src/specs/gl-api.spec
@@ -103,6 +103,10 @@ spec GL.API is
      Static => "glGetFloatv";
    procedure Get_Integer (Name   : Enums.Getter.Parameter;
                           Target : access Int) with Static => "glGetIntegerv";
+   procedure Get_Integer_Indexed (Name   : Enums.Getter.Parameter;
+                                  Index  : UInt;
+                                  Target : access Int) with
+     Dynamic => "glGetIntegeri_v";
    procedure Get_Int_Vec4 (Name   : Enums.Getter.Parameter;
                            Target : in out Ints.Vector4) with
      Static => "glGetIntegerv";
@@ -1300,4 +1304,16 @@ spec GL.API is
      Static => "glDepthRange", Wrapper => "GL.Window.Set_Depth_Range";
    procedure Viewport (X, Y : Int; Width, Height : Size) with
      Static => "glViewport", Wrapper => "GL.Window.Set_Viewport";
+
+   -----------------------------------------------------------------------------
+   --                             Compute Shaders                             --
+   -----------------------------------------------------------------------------
+
+   procedure Dispatch_Compute
+     (Num_Groups_X, Num_Groups_Y, Num_Groups_Z : UInt) with
+     Dynamic => "glDispatchCompute",
+     Wrapper => "GL.Compute.Dispatch_Compute";
+   procedure Memory_Barrier (Bits : Low_Level.Bitfield) with
+     Dynamic => "glMemoryBarrier",
+     Wrapper => "GL.Memory_Barriers.Memory_Barrier";
 end GL.API;
diff --git a/tests/opengl-test.gpr b/tests/opengl-test.gpr
@@ -11,7 +11,7 @@ project OpenGL.Test is
 
    for Main use ("gl_test-vbos", "gl_test-immediate", "gl_test-shaders",
                  "gl_test-opengl3", "gl_test-context", "gl_test-framebuffers",
-                 "gl_test-debugging");
+                 "gl_test-debugging", "gl_test-compute");
 
    package Ide renames OpenGL.Ide;
    package Builder renames OpenGL.Builder;
diff --git a/tests/src/gl/gl_test-compute-shader.glsl b/tests/src/gl/gl_test-compute-shader.glsl
@@ -0,0 +1,10 @@
+#version 430
+layout(local_size_x = 32) in;
+layout(std430, binding = 0) buffer data {
+   float values[];
+};
+
+void main() {
+   int x = int(gl_GlobalInvocationID.x);
+   values[x] = 2 * values[x];
+}
diff --git a/tests/src/gl/gl_test-compute.adb b/tests/src/gl/gl_test-compute.adb
@@ -0,0 +1,140 @@
+--  part of OpenGLAda, (c) 2022 Felix Krause
+--  released under the terms of the MIT license, see the file "COPYING"
+
+with Ada.Text_IO;
+
+with GL.Compute;
+with GL.Files;
+with GL.Memory_Barriers;
+with GL.Objects.Buffers;
+with GL.Objects.Shaders;
+with GL.Objects.Programs;
+with GL.Types;
+
+with GL_Test.Display_Backend;
+
+procedure GL_Test.Compute is
+   use GL.Types;
+
+   procedure Load_Singles is new GL.Objects.Buffers.Load_To_Buffer
+     (Single_Pointers);
+
+   procedure Map_Singles is new GL.Objects.Buffers.Map
+     (Single_Pointers);
+
+   Data_Count : constant := 1024;
+
+   Iteration_Count : Natural := 0;
+
+   Buffer          : GL.Objects.Buffers.Buffer;
+   Invalid         : GL.Objects.Buffers.Buffer;
+   Compute_Shader  : GL.Objects.Shaders.Shader
+     (Kind => GL.Objects.Shaders.Compute_Shader);
+   Program         : GL.Objects.Programs.Program;
+begin
+   Display_Backend.Init;
+   Display_Backend.Open_Window (Width => 500, Height => 500);
+
+   Buffer.Initialize_Id;
+   Invalid.Initialize_Id;
+   Compute_Shader.Initialize_Id;
+   Program.Initialize_Id;
+
+   --  initialize an SSBO with numbers from 1 to `Data_Count`
+   declare
+      use GL.Objects.Buffers;
+
+      Values : Single_Array (1 .. Data_Count);
+   begin
+      for I In Values'Range loop
+         Values (I) := Single (I);
+      end loop;
+      Shader_Storage_Buffer.Bind (Buffer);
+      Load_Singles
+        (Shader_Storage_Buffer,
+         Values,
+         Dynamic_Draw);
+      --  The following dummy bind is necessary for the Bind_Buffer_Base
+      --  to be effective. TODO: determine if it's a bug or not.
+      Shader_Storage_Buffer.Bind (Invalid);
+      Shader_Storage_Buffer.Bind_Buffer_Base (0, Buffer);
+   end;
+
+   -- load shader sources and compile shaders
+   GL.Files.Load_Shader_Source_From_File
+     (Compute_Shader, "../src/gl/gl_test-compute-shader.glsl");
+
+   Compute_Shader.Compile;
+
+   if not Compute_Shader.Compile_Status then
+      Ada.Text_IO.Put_Line ("Compilation of compute shader failed. log:");
+      Ada.Text_IO.Put_Line (Compute_Shader.Info_Log);
+   end if;
+
+   -- set up program
+   Program.Attach (Compute_Shader);
+   Program.Link;
+   if not Program.Link_Status then
+      Ada.Text_IO.Put_Line ("Program linking failed. Log:");
+      Ada.Text_IO.Put_Line (Program.Info_Log);
+      return;
+   end if;
+
+   -- check various constant
+   declare
+      use GL.Compute;
+   begin
+      for Index in Index_Type loop
+         Ada.Text_IO.Put ("Max compute work group count " & Index'Image & " :");
+         Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Count (Index)));
+      end loop;
+
+      for Index in Index_Type loop
+         Ada.Text_IO.Put ("Max compute work group size " & Index'Image & " :");
+         Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Size (Index)));
+      end loop;
+
+      Ada.Text_IO.Put ("Max compute work group invocations :");
+      Ada.Text_IO.Put_Line (Int'Image (Max_Compute_Work_Group_Invocations));
+   end;
+
+   Program.Use_Program;
+
+   -- dispatch compute shader 5 times
+   while Iteration_Count < 5 loop
+      --  local size for x axis is 32 as specified in the shader
+      GL.Compute.Dispatch_Compute (Data_Count / 32, 1, 1);
+      GL.Memory_Barriers.Memory_Barrier
+        ((Shader_Storage => True, others => False));
+      Iteration_Count := Iteration_Count + 1;
+   end loop;
+
+   --  print the final result to compare to the expected value
+   declare
+      use GL.Objects;
+      use GL.Objects.Buffers;
+
+      CPU_Total : Single := 0.0;
+      GPU_Total : Single := 0.0;
+
+      Value_Ptr : Single_Pointers.Pointer;
+   begin
+      Map_Singles (Shader_Storage_Buffer, Read_Only, Value_Ptr);
+
+      for I in 1 .. Data_Count loop
+         --  We run 5 iterations of the compute shader which simply doubles its
+         --  previous value, so this is ultimately the same as multiplying the
+         --  initial value by 2 ** 5 = 32.
+         CPU_Total := CPU_Total + Single (I) * 32.0;
+         GPU_Total := GPU_Total + Value_Ptr.all;
+         Single_Pointers.Increment (Value_Ptr);
+      end loop;
+
+      Unmap (Shader_Storage_Buffer);
+
+      Ada.Text_IO.Put_Line ("CPU Total : " & CPU_Total'Image);
+      Ada.Text_IO.Put_Line ("GPU Total : " & GPU_Total'Image);
+   end;
+
+   Display_Backend.Shutdown;
+end GL_Test.Compute;
