-- ----------------------------------------------------------------- --
-- --
-- This is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- ----------------------------------------------------------------- --
-- ----------------------------------------------------------------- --
-- This is a translation, to the Ada programming language, of the --
-- original C test files written by Sam Lantinga - www.libsdl.org --
-- translation made by Antonio F. Vargas - www.adapower.net/~avargas --
-- ----------------------------------------------------------------- --
with System.Address_To_Access_Conversions;
with Ada.Text_IO; use Ada.Text_IO;
with SDL.Thread;
package body TortureThread_Sprogs is
package Tr renames SDL.Thread;
function To_int is new Ada.Unchecked_Conversion (System.Address, C.int);
type Volatile_int is new C.int;
pragma Volatile (Volatile_int);
package int_Ptrs is
new System.Address_To_Access_Conversions (Volatile_int);
use int_Ptrs;
-- ======================================
function SubThreadFunc (data : System.Address) return C.int is
begin
while To_Pointer (data).all = 0 loop
null; -- SDL.Timer.SDL_Delay (10); -- do nothing
end loop;
return 0;
end SubThreadFunc;
-- ======================================
type flags_Array is
array (C.int range 0 .. NUMTHREADS - 1) of aliased Volatile_int;
pragma Convention (C, flags_Array);
flags : flags_Array;
-- ======================================
function ThreadFunc (data : System.Address) return C.int is
type sub_threads_Array is
array (C.int range 0 .. NUMTHREADS - 1) of Tr.SDL_Thread_ptr;
pragma Convention (C, sub_threads_Array);
sub_threads : sub_threads_Array;
tid : C.int := To_int (data);
begin
Put_Line ("Creating Thread " & C.int'Image (tid));
for i in flags'Range loop
flags (i) := 0;
sub_threads (i) :=
Tr.CreateThread (SubThreadFunc'Access,
To_Address (Object_Pointer'(flags (i)'Access)));
end loop;
Put_Line ("Thread '" & C.int'Image (tid) & "' waiting for signals");
while time_for_threads_to_die (tid) /= 1 loop
null; -- do nothing
end loop;
Put_Line ("Thread '" & C.int'Image (tid) & "' sending signals to subthreads");
for i in flags'Range loop
flags (i) := 1;
Tr.WaitThread (sub_threads (i), null);
end loop;
Put_Line ("Thread '" & C.int'Image (tid) & "' exiting");
return 0;
end ThreadFunc;
-- ======================================
end TortureThread_Sprogs;
syntax highlighted by Code2HTML, v. 0.9.1