{
    This file is part of Chentrah,
    Copyright (C) 2004-2012 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    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.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************

    This unit contains threading support for chentrah module,
      employing a hack for the Windows Structured Exception Handling
      mechanism (see cl_seh_hack.pp)

    This unit has some definitions borrowed from the System unit (FreePascal RTL)
      since these were defined in the implementation section,
      unavailable to other units.

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


unit mo_threads;
interface
uses SysUtils, Classes {$ifdef windows}, Windows {$else} , baseunix, dl {$endif}, syncobjs;

type
  TChentrahModuleThread = class(TThread)
  protected
    f_done: boolean;
    f_MyId: TThreadID;
    f_CrashMessage: WideString;
  public
    Log: WideString;
    CallStackLogged: boolean;
    constructor Create();
    property Done: boolean read f_done;
    function CheckForGenericDyingYells(call_stack_steps_to_skip: integer = 1): WideString;
    procedure AddCrashMessage(w: WideString);
    property Id: TThreadID read f_MyId;
    property CrashMessage: WideString read f_CrashMessage;
    procedure Execute; override;
    procedure Sleep;
    function PerformOneTask: longbool;
    function ItsTimeToTerminate: longbool;
    procedure Wait;
  end;

  TThreadManager = class
  private
    T: array of TChentrahModuleThread;
    Cs: TCriticalSection; //TRTLCriticalSection;
    function GetThreadNumById(tid:  TThreadID): integer;
  public
    StopRequested: longbool;
    constructor Create;
    procedure Start;
    function Stopped: system.boolean;
    function Crashed: system.boolean;
    procedure PassLog(w: WideString);
    procedure PassDying(w: WideString);
    destructor Destroy; override;
  end;

var
  Threadmanager: TThreadManager = nil;

implementation
  uses mo_hub;

  constructor TThreadManager.Create;
  begin
    Self.cs:= TCriticalSection.Create; //InitCriticalSection(Self.cs);
  end;

  destructor TThreadManager.Destroy;
  begin
    cs.Free; //DoneCriticalSection(Self.cs);
    inherited;
  end;

  function TThreadManager.GetThreadNumById(tid:  TThreadID): integer;
  var i: integer;
  begin
    for i:=0 to High(T) do if Assigned(T[i]) and (T[i].Id = tid) then Exit(i);
    Result:= -1;
  end;


  procedure TThreadManager.PassLog(w: WideString);
  var ct: TChentrahModuleThread;
  begin
    ct:= T[GetThreadNumById(GetCurrentThreadId())];
    if ct.Log <> '' then w:= #10#13 + w;
    try
      cs.Enter; //EnterCriticalSection(Self.cs);
      ct.Log+= w;
    finally
      cs.Leave; //LeaveCriticalSection(Self.cs);
    end;
  end;

  procedure TThreadManager.PassDying(w: WideString);
  var
    ct: TChentrahModuleThread;
    a, ca: pointer; i, sf: integer;
    crash_details: WideString;
  begin
    ct:= T[GetThreadNumById(GetCurrentThreadId())];

    if ct.CrashMessage = '' then begin
      //here's a functional analogue of CheckForGenericDyingYells():
      crash_details:= ct.CheckForGenericDyingYells(3);
      if crash_details <> '' then w += #10#13#10#13 + crash_details;
    end;

    ct.AddCrashMessage(w);
    raise exception.create('');
  end;

  procedure TThreadManager.Start;
  begin


  end;

  function TThreadManager.Stopped: system.boolean;
  begin


  end;


  function TThreadManager.Crashed: system.boolean;
  begin


  end;

  {$ifdef windows}
    {$ifdef cpu32}
      {$include mo_threads_seh_hack.inc}
    {$endif}
  {$endif}

  procedure TChentrahModuleThread.Execute;
  begin
    f_Done:= false;
    {$ifdef windows}
    Self.f_MyId:= GetCurrentThreadId;
      {$ifdef cpu32}
        SetUnhandledExceptionFilter(@MyExceptionFilter);
      {$endif}
    {$else}
   (*  Накуй не нужно
      FillChar(CgeSignalHandler, sizeof(CgeSignalHandler), 0);
      CgeSignalHandler.sa_handler := SigActionHandler(@MySignalDispatcher);
      CgeSignalHandler.sa_flags:=SA_SIGINFO;
      FpSigAction(SIGFPE, @CgeSignalHandler, @OldSigFpeHandler);
      FpSigAction(SIGSEGV,@CgeSignalHandler, @OldSigSegvHandler);
      FpSigAction(SIGBUS, @CgeSignalHandler, @OldSigBusHandler);
      FpSigAction(SIGILL, @CgeSignalHandler, @OldSigIllHandler);
    *)
    {$endif}
    try
      repeat
        if not Self.PerformOneTask then Self.Sleep;
      until Self.ItsTimeToTerminate;
    except
      Self.AddCrashMessage(Self.CheckForGenericDyingYells(1));
    end;
    f_done:= true;
  end;

  constructor TChentrahModuleThread.Create();
  begin
    inherited Create(true, MotherState^.ModuleThreadStackSize);

  end;

  procedure TChentrahModuleThread.AddCrashMessage(w: WideString);
  begin
    if Self.f_CrashMessage <> '' then w+= #10#13#10#13;
    Self.f_CrashMessage:= w + Self.f_CrashMessage;
  end;

  function TChentrahModuleThread.CheckForGenericDyingYells(call_stack_steps_to_skip: integer): WideString;
  var
    w: WideString;
    a, ca:pointer;
    i: integer;
  begin
    result:= '';
    if ExceptObject is Exception then begin
      w:= TellException(ExceptObject as Exception);
      if (w <> '' ) and (result <> '') then result+= #10#13#10#13 + w;
    end;
    if not CallStackLogged then begin
      CallStackLogged:= Yes;
      i:= 0;
      a:= get_frame;
      while Assigned(a) do begin
        ca:= get_caller_addr(a);
        {ignore the first three callers. These always are:
          0). call to this method from TThreadManager.PassDying()
          1). call to TThreadManager.PassDying() from Die()
          2). Call to Die() itself
        }
        if Assigned(ca) then begin
          if i = (call_stack_steps_to_skip) then begin
            if result <> '' then result+= #10#13#10#13;
            result+= 'Call stack:';
          end;
          if i >= (call_stack_steps_to_skip) then result+= #10#13'  ' + ShortExpAddr(ca);
          inc(i);
        end
        else Break;
        if i> MAX_STACK_FRAMES_DUMP then break;
        a:= get_caller_frame(a);
      end;
    end;
  end;



(*
Идея состоит в том, что поток забирает задачу из списка, после чего она пропадает из дерева.
Попытка сохранить работающую задачу должна приводить к краху.
Это не на неё должны ссылаться, а она должна ссылаться.
Выполненные задачи тоже в дерево не входят.
*)


  procedure TChentrahModuleThread.Sleep;
  begin


  end;


  function TChentrahModuleThread.PerformOneTask: longbool;
  begin


  end;


  function TChentrahModuleThread.ItsTimeToTerminate: longbool;
  begin


  end;


  procedure TChentrahModuleThread.Wait;
  begin


  end;

end.
