fpc/rtl/embedded/systhrd.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2002 by Peter Vreman,
    member of the Free Pascal development team.

    Embedded threading support implementation

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}


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