โŒ About FreshRSS

Normal view

There are new articles available, click to refresh the page.
Before yesterdayNews from the Ada programming language world

Stack corruption in Ada C binding to OpenGL function

I'm using SDL to retrieve the address of the function. That much seems to be working, since I'm using the same subprogram that's working for all my other function calls.

Here are all the relevant code snippits in the spec:

type GLenum is new Uint32;

subtype glTexImage2D_Target is GLenum with Static_Predicate => glTexImage2D_Target in GL_TEXTURE_2D | GL_TEXTURE_RECTANGLE | GL_PROXY_TEXTURE_RECTANGLE;
subtype glTexImage2D_Dtype is GLenum with Static_Predicate => glTexImage2D_Dtype in GL_BYTE | GL_UNSIGNED_BYTE;
subtype glTexImage2D_InternalFormat is GLenum with Static_Predicate => glTexImage2D_InternalFormat in GL_DEPTH_COMPONENT | GL_DEPTH_STENCIL | GL_RED | GL_RG | GL_RGB | GL_RGBA;
subtype glTexImage2D_Format is GLenum with Static_Predicate => glTexImage2D_Format in GL_RED | GL_RG | GL_RGB | GL_BGR | GL_RGBA | GL_BGRA | GL_RED_INTEGER | GL_RG_INTEGER | GL_RGB_INTEGER | GL_BGR_INTEGER | GL_RGBA_INTEGER | GL_BGRA_INTEGER | GL_STENCIL_INDEX | GL_DEPTH_COMPONENT | GL_DEPTH_STENCIL;

procedure glTexImage2D(target : glTexImage2D_Target; level : Integer; internalFormat : glTexImage2D_InternalFormat; width : Integer; height : Integer; format : glTexImage2D_Format; dtype : glTexImage2D_Dtype; pixels : System.Address) with Pre => (target /= GL_TEXTURE_RECTANGLE and target /= GL_PROXY_TEXTURE_RECTANGLE) or Level = 0;

procedure Set_OpenGL_Subprogram_Address(Addr : in out System.Address; Name : String);

glTexImage2D_C_Address : System.Address := System.Null_Address;

Could_Not_Load_OpenGL_Subprogram : exception;

And here are the relevant snippits in the body:

procedure glTexImage2D(target : glTexImage2D_Target; level : Integer; internalFormat : glTexImage2D_InternalFormat; width : Integer; height : Integer; format : glTexImage2D_Format; dtype : glTexImage2D_Dtype; pixels : System.Address) is
begin
    Set_OpenGL_Subprogram_Address(glTexImage2D_C_Address, "glTexImage2D");
    declare
        procedure glTexImage2D_C(target : GLenum; level : GLint; internalFormat : GLint; width : GLsizei; height : GLsizei; border : GLint; format : GLenum; dtype : GLenum; data : System.Address)
        with Import, Convention => Stdcall, Address => glTexImage2D_C_Address;
    begin
        glTexImage2D_C(GLenum(target), GLint(level), GLint(internalFormat), GLsizei(width), GLsizei(height), GLint'(0), GLenum(format), GLenum(dtype), pixels);
    end;
end glTexImage2D;

--This seems to work... but here it is just in case.
procedure Set_OpenGL_Subprogram_Address(Addr : in out System.Address; Name : String) is
begin
    if Addr = System.Null_Address then
        Addr := SDL_GL_GetProcAddress(Value(New_String(Name)));
        if Addr = System.Null_Address then
            raise Could_Not_Load_OpenGL_Subprogram with Name;
        end if;
    end if;
end Set_OpenGL_Subprogram_Address;

Finally, the pixels I'm passing in is an address indicating an object of type:

type Uc_Array is array(Integer range <>) of aliased Interfaces.C.unsigned_char;

The stack is being corrupted on the call to glTexImage2D_C. I discovered this by using gdb:

enter image description here

Here you can see the parameters I'm passing as well; target 3553, level 0, internalformat 6408, width 63, height 63, format 6408, dtype 5121, non-zero pixels address. The subprogram address is being set to a non-zero value. But after the call to glTexImage2D_C, the value of $sp (the stack pointer) has increased by 16#24#.

I've tried adjusting the height and width I pass to glTexImage2D_C, both to 10 and both to 1000, just to see if giving it more (or less) buffer prevents stack corruption, but in every case, the stack pointer is different before and after the procedure call.

I'm hoping this is a simple matter of an incorrect datatype or something... Here's the prototype of glTexImage2D on the OpenGL side:

void glTexImage2D(  GLenum target,
    GLint level,
    GLint internalformat,
    GLsizei width,
    GLsizei height,
    GLint border,
    GLenum format,
    GLenum type,
    const void * data);

(As a final note, I do intend to clean up the awkward lazy loading tactic you see above, if I can ever get this to actually work. For now I'm leaving it this way so I can eliminate the chance of trying to call a function that hasn't been loaded yet, while I'm still trying to debug the call itself. The tactic of using a nested procedure declared inside a declare...begin...end block is working for other OpenGL functions.)

Error setting the video mode when trying to run the compiled Game_Support example; GNAT Studio;

Trying to compile example /opt/gnatstudio/share/examples/training/games/bouncing/bouncing.gpr

There are no problems when compiling, but when running -

Error setting the video mode
UNCAUGHT EXCEPTION ===
raised STORAGE_ERROR : s-intman.adb:136 explicit raise

Code sample, which I used (it had been moved to another folder, because it does not want to compile in /opt/ - no rights).

with Display; use Display;
with Display.Basic; use Display.Basic;
with Ada.Numerics; use Ada.Numerics;
with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;

procedure Bouncing is
Seed : Generator;
Buffer_Size : constant := 1_200;

package F_Numeri is new Ada.Numerics.Generic_Elementary_Functions (Float);
use F_Numeri;

Base_Immunity : constant := 500;

type Ball is record
X, Y     : Float := 0.0;
Dx, Dy   : Float := 0.0;
Size     : Float := 0.0;
Mass     : Float := 1.0;
S        : Shape_Id := Null_Shape_Id;
Immunity : Integer := Base_Immunity;
end record
with Dynamic_Predicate => Ball.Mass > 0.0;

type Shape_Array_Type is array (Integer range <>) of Shape_Id;
type Ball_Array_Type is array (Integer range <>) of Ball;

Null_Ball : constant Ball := Ball'(X      => 0.0,
Y      => 0.0,
Dx     => 0.0,
Dy     => 0.0,
Size   => 0.0,
Mass   => 1.0,
S      => Null_Shape_Id,
Immunity => Base_Immunity);
Total_Ball : Integer := 0;

function Speed (B : Ball) return Float is
     (Sqrt (B.Dx * B.Dx + B.Dy * B.Dy));

function Cynetic_Energy (B : Ball) return Float is
     (1.0 / 2.0 * B.Mass * Speed (B) * Speed (B));

function Speed (Cy : Float; Mass : Float) return Float is
     (Sqrt (Cy * 2.0 / Mass));


procedure Create_Ball
     (X : Float; Y : Float; Mass : Float; Velocity : Float; Balls : in out Ball_Array_Type; J : Integer);


type Int_Array is array (Integer range <>) of Integer range 0 .. Buffer_Size;
type Bool_Array is array (Integer range <>) of Boolean;

protected Collision_Manager is
procedure Reset;
procedure Set_Collision (J, K : Integer);
procedure Keep_Immunity (J : Integer);
function Collision_With (J : Integer) return Integer;
function Should_Keep_Immunity (J : Integer) return Boolean;
private
Collision_Vector : Int_Array (1 .. Buffer_Size);
Immunity_Vector : Bool_Array (1 .. Buffer_Size);
end Collision_Manager;

protected body Collision_Manager is
procedure Reset is
begin
Collision_Vector := (others => 0);
Immunity_Vector := (others => False);
end Reset;

procedure Set_Collision (J, K : Integer) is
begin
Collision_Vector (J) := K;
end Set_Collision;

procedure Keep_Immunity (J : Integer) is
begin
Immunity_Vector (J) := True;
end Keep_Immunity;

function Collision_With (J : Integer) return Integer is
begin
return Collision_Vector (J);
end Collision_With;

function Should_Keep_Immunity (J : Integer) return Boolean is
begin
return Immunity_Vector (J);
end Should_Keep_Immunity;

end Collision_Manager;


procedure Create_Graphic (B : in out Ball) is
begin
B.S := New_Circle
        (B.X, B.Y, B.Size,
         (if B.Size > 15.0 then Blue
elsif B.Size > 10.0 then Green
elsif B.Size > 5.0 then Yellow
elsif B.Size > 2.0 then Magenta
else Red));
end Create_Graphic;

function Collision (B1, B2 : Ball) return Boolean is
Dx, Dy : Float;
Size : Float;
begin
if B1 = Null_Ball or else B2 = Null_Ball then
return False;
end if;

Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Size := B1.Size + B2.Size;

return Dx * Dx + Dy * Dy <= Size * Size;
end Collision;

procedure Bounce (B1, B2 : in out Ball) is
Dx : Float;
Dy : Float;
Length : Float;
Dvx : Float;
Dvy : Float;
Impulse : Float;
begin
Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Length := Sqrt (Dx * Dx + Dy * Dy);

if Length /= 0.0 then
Dx := Dx / Length;
Dy := Dy / Length;
Dvx := B1.Dx - B2.Dx;
Dvy := B1.Dy - B2.Dy;
Impulse := -2.0 *  (Dx * Dvx + Dy * Dvy);
Impulse := Impulse / (1.0 / B1.Mass + 1.0 / B2.Mass);

B1.Dx := B1.Dx + Dx * (Impulse / B1.Mass);
B1.Dy := B1.Dy + Dy * (Impulse / B1.Mass);

B2.Dx := B2.Dx - Dx * (Impulse / B2.Mass);
B2.Dy := B2.Dy - Dy * (Impulse / B2.Mass);
end if;
end Bounce;

procedure Explode (Balls : in out Ball_Array_Type; Index : Integer) is
B : Ball := Balls (Index);
V : Float;
Cy : Float;
Sub_Particles : Integer;
begin
Sub_Particles := Integer (Log (X => B.Mass, Base => 2.0) + 1.0);

Total_Ball := Total_Ball - 1;
V := Sqrt (B.Dx * B.Dx + B.Dy * B.Dy);
Cy := 1.0 / 2.0 * B.Mass * V * V;

Delete (Balls (Index).S);
Balls (Index) := Null_Ball;

for J in 1 .. Sub_Particles loop
for K in Balls'Range loop
if Balls (K) = Null_Ball then
Create_Ball
                 (X       => B.X + Random (Seed) * B.Size - B.Size / 2.0,
Y       => B.Y + Random (Seed) * B.Size - B.Size / 2.0,
Mass     => B.Mass / Float (Sub_Particles),
Velocity => Speed
                    (Cy / Float (Sub_Particles),
B.Mass / Float (Sub_Particles)),
Balls => Balls,
J => K);

Create_Graphic (Balls (K));

exit;
end if;
end loop;
end loop;
end Explode;

procedure Combine (Balls : in out Ball_Array_Type; J, K : Integer) is
B1 : Ball := Balls (J);
B2 : Ball := Balls (K);
Cy : Float := Cynetic_Energy (B1) + Cynetic_Energy (B2);
begin
Total_Ball := Total_Ball - 2;

Delete (Balls (K).S);
Balls (K) := Null_Ball;

Delete (Balls (J).S);

Create_Ball
        (B1.X + (B1.X - B2.X) / 2.0,
B1.Y + (B1.Y - B2.Y) / 2.0,
B1.Mass + B2.Mass,
Speed (Cy, B1.Mass + B2.Mass),
Balls,
J);

Create_Graphic (Balls (J));
end Combine;

procedure Create_Ball
     (X : Float; Y : Float; Mass : Float;
Velocity : Float; Balls : in out Ball_Array_Type; J : Integer)
is
B : Ball renames Balls (J);
Angle : Float := Random (Seed) * 2.0 * Pi;
begin
Total_Ball := Total_Ball + 1;
B.X := X;
B.Y := Y;


B.Dx := Cos (Angle) * Velocity;
B.Dy := Sin (Angle) * Velocity;

B.Mass := Mass;
B.Size := Sqrt (B.Mass);
B.Immunity := Base_Immunity;
Collision_Manager.Keep_Immunity (J);
end Create_Ball;


Lines : constant Shape_Array_Type (1 .. 4) :=
     (New_Line (-100.0, -100.0, 100.0, -100.0, Blue),
New_Line (-100.0, -100.0, -100.0, 100.0, Blue),
New_Line (100.0, 100.0, 100.0, -100.0, Blue),
New_Line (100.0, 100.0, -100.0, 100.0, Blue));

R : Float;

Balls_Txt : Shape_Id := New_Text (110.0, 90.0, "0", White);
Explode_Txt : Shape_Id := New_Text (110.0, 80.0, "0", White);
Combine_Txt : Shape_Id := New_Text (110.0, 70.0, "0", White);

Combine_Prob : Float := 0.04;
Explode_Prob : Float := 0.02;

Ball_Array : Ball_Array_Type (1 .. Buffer_Size) := (others => Null_Ball);


task type Collision_Detection (Size, Modulus, Ind : Integer) is
entry Compute;
entry Finished;
entry Stop;
end Collision_Detection;

task body Collision_Detection is
Do_Work : Boolean := True;
J : Integer;
begin
while Do_Work loop
select
accept Compute;

J := Ind;

if J = 0 then
J := J + Modulus;
end if;

while J <= Size loop
if Ball_Array (J) /= Null_Ball then
for K in J + 1 .. Ball_Array'Last loop
if Collision (Ball_Array (J), Ball_Array (K)) then
if Ball_Array (J).Immunity = 0
and then Ball_Array (K).Immunity = 0
then
Collision_Manager.Set_Collision (J, K);
end if;

Collision_Manager.Keep_Immunity (J);
Collision_Manager.Keep_Immunity (K);
end if;
end loop;
end if;

J := J + Modulus;
end loop;

accept Finished;
or
accept Stop;

Do_Work := False;
end select;
end loop;
end Collision_Detection;

D1 : Collision_Detection (1200, 4, 0);
D2 : Collision_Detection (1200, 4, 1);
D3 : Collision_Detection (1200, 4, 2);
D4 : Collision_Detection (1200, 4, 3);
begin
for J in 1 .. 20 loop
declare
B : Ball renames Ball_Array (J);
begin
Create_Ball (0.0, 0.0, Random (Seed) * 75.0 + 4.0, 0.5, Ball_Array, J);
Create_Graphic (B);
end;
end loop;

loop
Collision_Manager.Reset;

D1.Compute;
D2.Compute;
D3.Compute;
D4.Compute;

D1.Finished;
D2.Finished;
D3.Finished;
D4.Finished;

for J in Ball_Array'Range loop
if Ball_Array (J) /= Null_Ball then
declare
K : Integer;
begin
if not Collision_Manager.Should_Keep_Immunity (J) then
Ball_Array (J).Immunity := 0;
end if;

K := Collision_Manager.Collision_With (J);

if K /= 0 and then Ball_Array (K) /= Null_Ball then
R := Random (Seed);

if R in 1.0 - Explode_Prob - Combine_Prob
1.0 - Combine_Prob
then
if Ball_Array (J).Mass > Ball_Array (K).Mass then
Explode (Ball_Array, J);
else
Explode (Ball_Array, K);
end if;
elsif R in 1.0 - Combine_Prob .. 1.0 then
Combine (Ball_Array, J, K);
else
Bounce (Ball_Array (J), Ball_Array (K));
end if;
end if;
end;
end if;
end loop;

for J in Ball_Array'Range loop
declare
B : Ball renames Ball_Array (J);
begin
if B /= Null_Ball then
if (B.X - B.Size < -100.0 and then B.Dx < 0.0)
or else (B.X + B.Size > 100.0 and then B.Dx > 0.0)
then
B.Dx := -B.Dx;
end if;

if (B.Y - B.Size< -100.0 and then B.Dy < 0.0)
or else (B.Y + B.Size> 100.0 and then B.Dy > 0.0)
then
B.Dy := -B.Dy;
end if;

B.X := B.X + B.Dx;
B.Y := B.Y + B.Dy;

if B.Immunity > 0 then
B.Immunity := B.Immunity - 1;
end if;

Set_X (B.S, B.X);
Set_Y (B.S, B.Y);
end if;
end;
end loop;

Set_Text (Balls_Txt, "Balls:" & Total_Ball'Img);
Set_Text (Explode_Txt, "Explode Prob:" & Integer (Explode_Prob * 1000.0)'Img & " / 1000");
Set_Text (Combine_Txt, "Combine Prob:" & Integer (Combine_Prob * 1000.0)'Img & " / 1000");

declare
Last_Key : Key_Type := Current_Key_Press;
begin
if To_Character (Last_Key) = 'q' then
Explode_Prob := Explode_Prob - 0.001;
elsif To_Character (Last_Key) = 'w' then
Explode_Prob := Explode_Prob + 0.001;
elsif To_Character (Last_Key) = 'a' then
Combine_Prob := Combine_Prob - 0.001;
elsif To_Character (Last_Key) = 's' then
Combine_Prob := Combine_Prob + 0.001;
end if;
end;

delay 0.01;
end loop;
end Bouncing;

The project file itself

bouncing.gpr

with "/opt/gnatstudio/share/gpr/game_support.gpr";
with "/opt/gnatstudio/share/gpr/gnat_sdl.gpr";

project bouncing is

for Main use("bouncing.adb");

for Object_Dir use "obj";
for Source_Dirs use("src");

end Bouncing;


tually, I had been compile and run some more simple example with the same result:

with Display; use Display;
with Display.Basic; use Display.Basic;

procedure Main is
Ball : Shape_Id := New_Circle
     (X      => 0.0,
Y      => 0.0,
Radius => 10.0,
Color  => Blue);
Step : Float := 0.05;
begin
loop
if Get_X (Ball) > 100.0 then
Step := -0.05;
elsif Get_X (Ball) < -100.0 then
Step := 0.05;
end if;

Set_X (Ball, Get_X (Ball) + Step);

delay 0.001;
end loop;
end Main;

I had tried to recompile Game_Support, git cloned from here.

I had tried to reinstall GNAT, Gnat Studio, etc.

I CAN run and compile another simple projects, for example with TEXT_IO package, I can run Gnat Studio, but I cannot run this app. I can run analogue, wrote with C++, so the problem is not in my OpenGl 1.3 hardware support.

  • System: Arch Linux.
  • IDE: Gnat Studio. (Install from AUR).
  • Dependencies (SDL, SDL2) - installed.
โŒ
โŒ