Thread.library

thread.library

[insert background information here]

examples

Example: Single thread

Original c-source [1]

Program CleanupAtExit;


{$MODE OBJFPC} {$H+}


uses
  amigados, contrib_thread;


Function thread_main(data: pvoid): pvoid; cdecl;
var
  i: integer;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  Writeln(ThisOutput, 'thread starting');

  for i := 0 to 10-1 do
  begin
    writeln(ThisOutPut,'count: ', i);
    DOSDelay(25);
  end;

  Writeln(ThisOutput, 'thread exiting');

  result := nil;
end;



Begin
  writeln('enter');

  CreateThread(@thread_main, nil);
  DosDelay(100);
  ExitCode := 0;

  writeln('leave');
End.

Example: Two threads

Original c-source [2]

Program twothreads;

{$MODE OBJFPC} {$H+}

uses
  amigados, contrib_thread;

Var
  t1, t2: uint32_t;

{
   Remark: in freepascal some funtionality cannot be used within the
   actual thread (read outside the main thread).
   One example being write and/or writeln routines. Those routines
   seems to miss the context of the thread that the threadlibrary
   created. Therefor the write(ln) will fail.

   Also usage of some AROS libraries will lead to failure (without
   taking proper measures) as there are different type of libraries:
   - shared (which can be used),
   - per-task (only connect to _one_ task, and another thread is
     not the same task)
   - per-opener (which should be opened on a per use base).

   Therefor failure/succes of using certain commands and/or library
   functions in the thread will depend on which libraries you open
   or don't open in a thread (= which libbase you will use).
   The same goes for the Freepascal functions (that eventually call
   AROS system libraries as well).
}
function thread_main(data: pvoid): pvoid; cdecl;
var
  id         : uint32_t;
  i          : integer;
  ThisOutput : Text;
Begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  id := CurrentThread();

  writeln(ThisOutput, '[', id, '] starting');

  for i := 0 to 10-1 do
  Begin
    WriteLn(ThisOutput, '[', id, '] count: ', i);
    DosDelay(25);
  End;

  writeln(ThisOutput,'[', id, '] exiting');

  result := nil;
End;


Begin
  writeln('enter');

  t1 := contrib_thread.CreateThread(@thread_main, nil);
  WriteLn('Created thread ', t1);

  DosDelay(100);

  t2 := CreateThread(@thread_main, nil);
  WriteLn('Created thread ', t2);

  WriteLn('waiting for thread ', t2);
  WaitThread(t2, nil);
  WriteLn('thread ', t2, ' completed');

  WriteLn('waiting for thread ', t1);
  WaitThread(t1, nil);
  WriteLn('thread ', t1, ' completed');

  ExitCode := 0;
  writeln('leave');
End.

Example: Multiple threads

Original c-source [3]

Program ThreadExit;

{$MODE OBJFPC} {$H+}

uses
  amigados, contrib_thread;


Function thread_main(data: pvoid): pvoid; cdecl;
var
  id: uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  id := CurrentThread();

  writeln(ThisOutput, '[', id, '] starting');

  DosDelay(50);

  writeln(ThisOutput, '[', id, '] exiting');

  result := pvoid(id);
end;



Var
  i   : Integer;
  id  : Array[0..10-1] of uint32_t;
  ret : uint32_t;
Begin
  writeln('enter');

  for i := 0 to 10-1 do
  begin
    id[i] := CreateThread(@thread_main, nil);
    writeln('created thread ', id[i]);
    DosDelay(25);
  end;

  for i := 0 to 10-1 do
  begin
    writeln('waiting for thread ', id[i]);
    WaitThread(id[i], @ret);
    writeln('thread ', id[i], 'return ', ret);
  end;

  ExitCode := 0;
  writeln('leave');
End.

Example: Subthreads (and lot's of them)

Original c-source [4]

Program ExitThread;


{$MODE OBJFPC} {$H+}

{
   Because this example creates _a lot_ of subthreads
   we run out of stack. So we compensate otherwise we 
   would recieve a RUNTIME ERROR 202 (Stack overflow 
   error).
}

{$M 2000000, 2000000}

uses
  amigados, contrib_thread;



Function thread_sub(data: pvoid): pvoid; cdecl;
var
  id: uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  id := CurrentThread();

  writeln(ThisOutput, '[', id, '] starting sub');

  DosDelay(50);

  writeln(ThisOutput, '[', id, '] exiting sub');

  contrib_thread.ExitThread(pvoid(id));

  result := nil;
end;



Function thread_main(data: pvoid): pvoid; cdecl;
var
  i          : integer;
  id_sub     : Array[0..10-1] of uint32_t;
  ret        : uint32_t;
  id         : uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  id := CurrentThread();

  writeln(ThisOutput, '[', id, '] starting');

  DosDelay(50);

  for i := 0 to 10-1 do
  begin
    id_sub[i] := CreateThread(@thread_sub, nil);
    writeln(ThisOutput, 'created sub thread ', id_sub[i]);
  end;

  writeln(ThisOutput, '[', id, '] exiting');

  for i := 0 to 10-1 do
  begin
    writeln(ThisOutput, 'waiting for sub thread ', id_sub[i]);
    WaitThread(id_sub[i], @ret);
    writeln(ThisOutput, 'sub thread ', id_sub[i], ' return ', ret);
  end;

  contrib_Thread.ExitThread(pvoid(id));

  result := nil;
end;



Var
  i    : Integer;
  id   : Array[0..10-1] of uint32_t;
  ret  : uint32_t;

Begin
  writeln('enter');

  for i := 0 to 10-1 do
  begin
    id[i] := CreateThread(@thread_main, nil);
    writeln('created thread ', id[i]);
  end;

  for i := 0 to 10-1 do
  begin
    writeln('waiting for thread ', id[i]);
    WaitThread(id[i], @ret);
    writeln('thread ', id[i], ' return ', ret);
  end;

  ExitCode := 0;

  writeln('leave');
End.

Example: Using a mutex amongst threads

Original c-source [5]

program mutex;


{$MODE OBJFPC} {$H+}


uses
  exec, amigados, contrib_thread;


function locker_thread(data: pvoid): pvoid; cdecl;
var
  mutex      : pvoid;
  id         : uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  mutex := data;
  id := CurrentThread();

  writeln(ThisOutput, '[',id,'] starting, locking the mutex');
  LockMutex(mutex);

  writeln(ThisOutput, '[',id,'] got it, pausing for 5s');
  DosDelay(250);

  writeln(ThisOutput, '[',id,'] unlocking the mutex');
  UnlockMutex(mutex);

  writeln(ThisOutput, '[',id,'] all done, exiting');

  result := nil;
end;


function waiter_thread(data: pvoid): pvoid; cdecl;
var
  mutex      : pvoid;
  id         : uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  mutex := data;
  id := CurrentThread();

  writeln(ThisOutput, '[',id,'] starting, locking the mutex');
  LockMutex(mutex);

  writeln(ThisOutput, '[',id,'] got it, unlocking');
  UnlockMutex(mutex);

  writeln(ThisOutput, '[',id,'] all done, exiting');

  result := nil;
end;



var
  thismutex  : pvoid;
  tw, tl : uint32_t;

begin
  writeln('enter');

  writeln('creating mutex');
  thismutex := CreateMutex();

  writeln('starting locker thread');
  tl := CreateThread(@locker_thread, thismutex);

  writeln('sleeping for 2s');
  DosDelay(100);

  writeln('starting waiter thread');
  tw := CreateThread(@waiter_thread, thismutex);

  writeln('waiting for locker thread to exit');
  WaitThread(tl, nil);

  writeln('waiting for waiter thread to exit');
  WaitThread(tw, nil);

  writeln('destroying the mutex');
  DestroyMutex(thismutex);

  writeln('all done');

  writeln('leave');
end.

Example: Signalling a condition

Original c-source [6]

program signalcond;


{$MODE OBJFPC} {$H+}


uses
  exec, amigados, contrib_thread;


Type
  PThread_Data = ^TThread_Data;
  TThread_Data = record
    mutex: pvoid;
    cond : pvoid;
  end;



function waiter_thread(data: pvoid): pvoid; cdecl;
var
  td         : pThread_Data;
  id         : uint32_t;
  ThisOutput : Text;
Begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  td := data;
  id := CurrentThread();

  writeln(ThisOutput, '[',id,'] starting, locking the mutex');
  LockMutex(td^.mutex);

  writeln(ThisOutput,'[',id,'] waiting on the condition');
  WaitCondition(td^.cond, td^.mutex);

  writeln(ThisOutput,'[',id,'] condition signalled, unlocking the mutex');
  UnlockMutex(td^.mutex);

  writeln(ThisOutput,'[',id,'] all done, exiting');

  result := nil;
end;



var
  td : pthread_data;
  tw : uint32_t;
begin
  writeln('enter');

  td := AllocMem(sizeOf(TThread_data), MEMF_PUBLIC or MEMF_CLEAR);

  writeln('creating mutex');
  td^.mutex := CreateMutex();

  writeln('creating condition');
  td^.cond := CreateCondition();

  writeln('starting waiter thread');
  tw := CreateThread(@waiter_thread, td);

  writeln('sleeping for 2s');
  DosDelay(100);

  writeln('signalling condition');
  SignalCondition(td^.cond);

  writeln('waiting for waiter thread');
  WaitThread(tw, nil);

  writeln('destroying the condition');
  DestroyCondition(td^.cond);

  writeln('destroying the mutex');
  DestroyMutex(td^.mutex);

  FreeMem(td, sizeof(TThread_Data));

  writeln('all done');

  ExitCode := 0;

  writeln('leave');
end.

Example: Broadcasting a condition

Original c-source [7]

Program BroadcastCond;

{$MODE OBJFPC} {$H+}

uses
  exec, amigados, contrib_thread;


Type
  pthread_data = ^tthread_data;
  TThread_Data = record
    mutex : pvoid;
    cond  : pvoid;
  end;



Function waiter_thread(data: pvoid): pvoid; cdecl;
var
  td         : pthread_data;
  id         : uint32_t;
  ThisOutput : Text;
begin
  {$WARNING "Grabbing Output from main thread in this manner is not thread-safe"}
  ThisOutput := System.Output;

  td := data;
  id := CurrentThread();

  writeln(ThisOutput, '[',id,'] starting, locking the mutex');
  LockMutex(td^.mutex);

  writeln(ThisOutput, '[',id,'] waiting on the condition');
  WaitCondition(td^.cond, td^.mutex);

  writeln(ThisOutput, '[',id,'] condition signalled, unlocking the mutex');
  UnlockMutex(td^.mutex);

  writeln(ThisOutput, '[',id,'] all done, exiting');

  result := nil;
end;



var
  td : pthread_data;
  i  : integer;


Begin
  writeln('enter');

  td := Exec.AllocMem(sizeof(tthread_data), MEMF_PUBLIC or MEMF_CLEAR);

  writeln('creating mutex');
  td^.mutex := CreateMutex();

  writeln('creating condition');
  td^.cond := CreateCondition();

  writeln('starting waiter threads');
  for i := 0 to 5-1
    do CreateThread(@waiter_thread, td);

  writeln('sleeping for 2s');
  DOSDelay(100);

  writeln('signalling condition');
  SignalCondition(td^.cond);

  writeln('sleeping for 2s');
  DOSDelay(100);


  writeln('broadcasting condition');
  BroadcastCondition(td^.cond);

  writeln('waiting for threads to exit');
  WaitAllThreads();

  writeln('destroying the condition');
  DestroyCondition(td^.cond);

  writeln('destroying the mutex');
  DestroyMutex(td^.mutex);


  ExecFreeMem(td, sizeof(tthread_data));
  writeln('all done');

  ExitCode := 0;

  writeln('leave');
End.

the unit

unit contrib_thread;


{$MODE OBJFPC} {$H+} {$PACKRECORDS C}

Interface

uses
  Exec;



Type
  uint32_t = LongWord;
//  pvoid    = TProcedure;
//  pvoid    = pointer;

//  ppvoid   = ^pvoid;
//  BOOL     = LongBool;


Type
  TThreadEntryFunction = Function(data: pvoid): pvoid; cdecl;



Var
  ThreadBase: pLibrary;


  Function  CreateThread(entry: TThreadEntryFunction; data: pvoid): uint32_t;
  Function  WaitThread(thread_id: uint32_t; res: ppvoid): BOOL;
  Procedure WaitAllThreads;
  Function  DetachThread(thread_id: uint32_t): BOOL;
  Function  CurrentThread: uint32_t;
  Function  CreateMutex: pvoid;
  Function  DestroyMutex(mutex: pvoid): BOOL;
  Procedure LockMutex(mutex: pvoid);
  Function  TryLockMutex(mutex: pvoid): BOOL;
  Procedure UnlockMutex(mutex: pvoid);
  Function  CreateCondition: pvoid;
  Function  DestroyCondition(condition: pvoid): BOOL;
  Function  WaitCondition(condition: pvoid; mutex: pvoid): BOOL;
  Procedure SignalCondition(condition: pvoid);
  Procedure BroadcastCondition(condition: pvoid);
  Procedure ExitThread(res: pvoid);


Implementation



Function  CreateThread(entry: TThreadEntryFunction; data: pvoid): uint32_t;
Type
  TLocalCall = Function(entry: TThreadEntryFunction; data: pvoid; LibBase: Pointer): uint32_t; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 5));
  CreateThread := Call(entry, data, ThreadBase);
End;



Function  WaitThread(thread_id: uint32_t; res: ppvoid): BOOL;
Type
  TLocalCall = Function(thread_id: uint32_t; res: ppvoid; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 6));
  WaitThread := Call(thread_id, res, ThreadBase);
End;



Procedure WaitAllThreads;
Type
  TLocalCall = Procedure(LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 7));
  Call(ThreadBase);
End;



Function  DetachThread(thread_id: uint32_t): BOOL;
Type
  TLocalCall = Function(thread_id: uint32_t; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 8));
  DetachThread := Call(thread_id, ThreadBase);
End;



Function  CurrentThread: uint32_t;
Type
  TLocalCall = Function(LibBase: Pointer): uint32_t; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 9));
  CurrentThread := Call(ThreadBase);
End;



Function  CreateMutex: pvoid;
Type
  TLocalCall = Function(LibBase: Pointer): pvoid; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 10));
  CreateMutex := Call(ThreadBase);
End;



Function  DestroyMutex(mutex: pvoid): BOOL;
Type
  TLocalCall = Function(mutex: pvoid; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 11));
  DestroyMutex := Call(mutex, ThreadBase);
End;



Procedure LockMutex(mutex: pvoid);
Type
  TLocalCall = Procedure(mutex: pvoid; LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 12));
  Call(mutex, ThreadBase);
End;



Function  TryLockMutex(mutex: pvoid): BOOL;
Type
  TLocalCall = Function(mutex: pvoid; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 13));
  TryLockMutex := Call(mutex, ThreadBase);
End;



Procedure UnlockMutex(mutex: pvoid);
Type
  TLocalCall = Procedure(mutex: pvoid; LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 14));
  Call(mutex, ThreadBase);
End;



Function  CreateCondition: pvoid;
Type
  TLocalCall = Function(LibBase: Pointer): pvoid; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 15));
  CreateCondition := Call(ThreadBase);
End;


Function  DestroyCondition(condition: pvoid): BOOL;
Type
  TLocalCall = Function(condition: pvoid; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 16));
  DestroyCondition := Call(condition, ThreadBase);
End;


Function  WaitCondition(condition: pvoid; mutex: pvoid): BOOL;
Type
  TLocalCall = Function(condition: pvoid; mutex: pvoid; LibBase: Pointer): BOOL; cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 17));
  WaitCondition := Call(condition, mutex, ThreadBase);
End;


Procedure SignalCondition(condition: pvoid);
Type
  TLocalCall = Procedure(condition: pvoid; LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 18));
  Call(condition, ThreadBase);
End;


Procedure BroadcastCondition(condition: pvoid);
Type
  TLocalCall = Procedure(condition: pvoid; LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 19));
  Call(condition, ThreadBase);
End;


Procedure ExitThread(res: pvoid);
Type
  TLocalCall = Procedure(res: pvoid; LibBase: Pointer); cdecl;
Var
  Call: TLocalCall;
Begin
  Call := TLocalCall(GetLibAdress(ThreadBase, 20));
  Call(res, ThreadBase);
End;



Initialization
  ThreadBase := OpenLibrary('Thread.library',0);

Finalization
  CloseLibrary(ThreadBase);

end.