Thread.library
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
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.
unit documentation
A bit rough around the edges. No var /var was done, and only some basic links to other units (types etc.).