Thread.library

threads.library

[insert background information here]

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.