paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 18:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ skeleton of an embedded thread manager

Browse Source 
git-svn-id: trunk@49501 -
This commit is contained in:
florian 2021-06-14 21:24:18 +00:00
parent 8608b82c01
commit 2e086a2570
2 changed files with 113 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/embedded/system.pp
View File

@ -300,7 +300,7 @@ begin
{$ifdef FPC_HAS_FEATURE_THREADING}
{ threading }
//InitSystemThreads; // Empty call for embedded anyway
InitSystemThreads;
{$endif FPC_HAS_FEATURE_THREADING}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

115
rtl/embedded/systhrd.inc
View File

@ -3,7 +3,7 @@
Copyright (c) 2002 by Peter Vreman,
member of the Free Pascal development team.
Embedded empty threading support implementation
Embedded threading support implementation
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -14,8 +14,117 @@
**********************************************************************}
{ resourcestrings are not supported by the system unit,
they are in the objpas unit and not available for fpc/tp modes }
const
SNoThreads = 'This binary has no thread support compiled in.';
SRecompileWithThreads = 'Recompile the application with a thread-driver in the program uses clause before other units using thread.';
Procedure NoThreadError;NoReturn;
begin
{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
If IsConsole then
begin
Writeln(StdErr,SNoThreads);
Writeln(StdErr,SRecompileWithThreads);
end;
{$endif FPC_HAS_FEATURE_CONSOLEIO}
{ providing an rte on embedded makes often little sense and
runerror(...) would pull in a lot of unnecessary code }
system_exit;
end;
function NoGetCurrentThreadId : TThreadID;
begin
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
result:=TThreadID(1);
end;
function NoBeginThread(sa : Pointer;stacksize : PtrUInt;
ThreadFunction : tthreadfunc;p : pointer;
creationFlags : dword; var ThreadId : TThreadID) : TThreadID;NoReturn;
begin
NoThreadError;
result:=tthreadid(-1);
end;
procedure SysInitCriticalSection(var cs);
begin
end;
procedure SysDoneCriticalSection(var cs);
begin
end;
procedure SysEnterCriticalSection(var cs);
begin
end;
function SysTryEnterCriticalSection(var cs):longint;
begin
end;
procedure SysLeaveCriticalSection(var cs);
begin
end;
const
EmbeddedThreadManager : TThreadManager = (
InitManager : Nil;
DoneManager : Nil;
{ while this is pretty hacky, it reduces the size of typical embedded programs
and works fine on arm and avr }
BeginThread : @NoBeginThread;
EndThread : TEndThreadHandler(@NoThreadError);
SuspendThread : TThreadHandler(@NoThreadError);
ResumeThread : TThreadHandler(@NoThreadError);
KillThread : TThreadHandler(@NoThreadError);
CloseThread : TThreadHandler(@NoThreadError);
ThreadSwitch : TThreadSwitchHandler(@NoThreadError);
WaitForThreadTerminate : TWaitForThreadTerminateHandler(@NoThreadError);
ThreadSetPriority : TThreadSetPriorityHandler(@NoThreadError);
ThreadGetPriority : TThreadGetPriorityHandler(@NoThreadError);
GetCurrentThreadId : @NoGetCurrentThreadId;
SetThreadDebugNameA : TThreadSetThreadDebugNameHandlerA(@NoThreadError);
{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
SetThreadDebugNameU : TThreadSetThreadDebugNameHandlerU(@NoThreadError);
{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
InitCriticalSection : @SysInitCriticalSection;
DoneCriticalSection : @SysDoneCriticalSection;
EnterCriticalSection : @SysEnterCriticalSection;
TryEnterCriticalSection: @SysTryEnterCriticalSection;
LeaveCriticalSection : @SysLeaveCriticalSection;
InitThreadVar : TInitThreadVarHandler(@NoThreadError);
RelocateThreadVar : TRelocateThreadVarHandler(@NoThreadError);
AllocateThreadVars : @NoThreadError;
ReleaseThreadVars : @NoThreadError;
BasicEventCreate : TBasicEventCreateHandler(@NoThreadError);
BasicEventdestroy : TBasicEventHandler(@NoThreadError);
BasicEventResetEvent : TBasicEventHandler(@NoThreadError);
BasicEventSetEvent : TBasicEventHandler(@NoThreadError);
BasicEventWaitFor : TBasicEventWaitForHandler(@NoThreadError);
RTLEventCreate : TRTLCreateEventHandler(@NoThreadError);
RTLEventdestroy : TRTLEventHandler(@NoThreadError);
RTLEventSetEvent : TRTLEventHandler(@NoThreadError);
RTLEventResetEvent : TRTLEventHandler(@NoThreadError);
RTLEventWaitFor : TRTLEventHandler(@NoThreadError);
RTLEventwaitfortimeout : TRTLEventHandlerTimeout(@NoThreadError);
);
Procedure InitSystemThreads;
begin
{ calling SetThreadManager pulls in too much code }
CurrentTM:=EmbeddedThreadManager;
end;