+ skeleton of an embedded thread manager

git-svn-id: trunk@49501 -

rtl/embedded/system.pp

@@ -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}

rtl/embedded/systhrd.inc

@@ -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;
-
-