Thread.library

thread.library

[insert background information here]

examples

Example: Single thread

Original c-code [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.

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.