{
    This file is part of Chentrah,
    Copyright (C) 2004-2008 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 file contains the log/error processing routines.

 **********************************************************************}
 
//Temporary. To be incorporated later into the module body.


  function BoolChars(b: boolean): string;
  begin
    if b then Result:='True' else Result:='False';
  end;

  function VarRecToWide(V: TVarRec): WideString;
  begin
    Case V.Vtype of
      vtInteger:    Result := IntToStr(V.VInteger);
      vtBoolean:    Result := AnsiToWide(BoolChars(V.VBoolean));
      vtChar:   Result := AnsiToWide(V.VChar);
      vtWideChar:   Result:=V.VWideChar;
      vtExtended:   Result := FloatToStr(V.VExtended^);
      vtAnsiString: Result := AnsiToWide(AnsiString(V.VAnsiString));
      vtWideString: Result := WideString(V.VWideString);
      vtPChar:  Result := AnsiToWide(PCharToString(V.VPChar));
      vtPWideChar:  Result := PWideCharToWideString(V.VPWideChar);
      vtObject:     Result := AnsiToWide(string(V.VObject.ClassName));
      vtClass:      Result := AnsiToWide(string(V.VClass.ClassName));
      vtPointer: begin
        if Assigned(V.VPointer) then Result:= Format('%Ph',[V.VPointer])
                                else Result:='NIL';
      end;

      //not supported in the FreePascal 1.0.6:
      vtCurrency:   Result := CurrToStr(V.VCurrency^);
      vtVariant:    Result := string(V.VVariant^);

      vtInt64:      Result := IntToStr(V.VInt64^);
      vtQword:      Result := IntToStr(V.VQword^);
    else
      Result:=RuEn('?неизвестный подтип VarRec?','?unknown VarRec type?');
    end;
  end;

  function PervertedFormat(U: WideString; P: array of const): WideString; //OVERLOAD;
  var
    j: integer;
    b, e: WideString;
  begin
    e:='';
    For j:=0 to High(p) do begin
      b:=VarRecToWide(P[j]);
      if WidePos('%' + IntToStr(j), U) < 1
        then e:=e + '  [' + b + ']  '
        else u:=WideReplace(u, '%' + IntToStr(j), b);
    end;
    if e <> '' then begin
      e:=RuEn(' +ОШИБКА РАЗБИЕНИЯ!! ', ' +FORMAT ERROR!! ') + e;
    end;
    Result:=u + e;
  end;
  
  function StrOrUndefined(U: WideString): WideString;
  begin
    if U='' then Result:=PWideCharToWideString(_HostMsg(MI_UNDEFINED))
            else Result:=U;
    AfterEfCheck;
  end;

 {$ifdef win32}
  function Win32LastError: WideString;
  var
    M: Cardinal;
    u: WideString;
  begin
    Result:='';
{    M:=GetLastError;
    if M = ERROR_SUCCESS then Result:=''
    else begin
      u:=AnsiToWide(SysErrorMessage(M));
      Result:=#10#13 + Result + #10#13 + PervertedFormat(
        PWideCharToWideString(MsgRaw(MI_WIN32_EXPLAINS)),
        [IntToHex(M, 8), u]);
    end;}
  end;
 {$endif}

    var _dyell: WideString;

    function ExceptObjectisException: boolean;
    begin
      Try
        Result:=ExceptObject is Exception;
      Except
        Result:=No;
      End;
    end;





{$ifdef windows}
  function SehNameByCode(c: Dword): WideString;
  begin
    case c of
      $C0000005: Result:= 'ACCESS_VIOLATION';
      $C0000006: Result:= 'IN_PAGE_ERROR';
      $C0000008: Result:= 'INVALID_HANDLE';
      $C0000017: Result:= 'NO_MEMORY';
      $C000001D: Result:= 'ILLEGAL_INSTRUCTION';
      $C0000025: Result:= 'NONCONTINUABLE_EXCEPTION';
      $C0000026: Result:= 'INVALID_DISPOSITION';
      $C000008C: Result:= 'ARRAY_BOUNDS_EXCEEDED';
      $C000008D: Result:= 'FLOAT_DENORMAL_OPERAND';
      $C000008E: Result:= 'FLOAT_DIVIDE_BY_ZERO';
      $C000008F: Result:= 'FLOAT_INEXACT_RESULT';
      $C0000090: Result:= 'FLOAT_INVALID_OPERATION';
      $C0000091: Result:= 'FLOAT_OVERFLOW';
      $C0000092: Result:= 'FLOAT_STACK_CHECK';
      $C0000093: Result:= 'FLOAT_UNDERFLOW';
      $C0000094: Result:= 'INTEGER_DIVIDE_BY_ZERO';
      $C0000095: Result:= 'INTEGER_OVERFLOW';
      $C0000096: Result:= 'PRIVILEGED_INSTRUCTION';
      $C00000FD: Result:= 'STACK_OVERFLOW';
      $C000013A: Result:= 'CONTROL_C_EXIT';
      $C00002B4: Result:= 'FLOAT_MULTIPLE_FAULTS';
      $C00002B5: Result:= 'FLOAT_MULTIPLE_TRAPS';
      $C00002C9: Result:= 'REG_NAT_CONSUMPTION';
    else
      Result:= RuEn('Неизвестное ','Unknown ') + IntToHex(c, 8) + 'h'
    end;
  end;
{$else}
  function SehNameByCode(c: Dword): WideString;
  begin
    case c of
       1: Result:= 'SIGFPE, Floating point exception -- no further details available';
       2: Result:= 'SIGFPE, Division by zero';
       3: Result:= 'SIGFPE, Invalid FPU state';
       4: Result:= 'SIGFPE, Floating point overflow';
       5: Result:= 'SIGFPE, Floating point underflow';
       6: Result:= 'SIGFPE, Floating point denormal';
       7: Result:= 'SIGFPE, Floating point exception';
       8: Result:= 'SIGBUS';
       9: Result:= 'SIGILL, Access Violation';
      10: Result:= 'SIGSEGV, Access Violation';
    else
      Result:= RuEn('Неизвестное ','Unknown ') + IntToHex(c, 8) + 'h'
    end;
  end;
{$endif}

  type MyException = class(Exception);

  procedure MySafeCallErrorProc(error : HResult;addr : pointer);
  var a, ca: pointer; i: integer;
    p: procedure; register;
  begin
    Raise Exception(NIL) at addr;//MyException.Create('blah') at addr;
    addlog('safecall %0',[IntToHex(error,8)]);
    if error <> 0 then begin
      SafeCallExceptionCaught:= true;
      Die(RuEn('Исключение при safecall вызове.','Safecall exception.'));
    end
    else begin
      asm
        MOV EAX, DWORD[addr];
        JMP EAX;
      end;
    end;
(*    //try Die(RuEn('Исключение при safecall вызове.','Safecall exception.')) except end;
    _dyell:= RuEn('Safecall-исключение: ','Safecall exception: ')
      + SehNameByCode(error)
      + #10#13'  ' + SehHackTellExceptionAddress(cardinal(addr));
    if not MotherState.NowDying
     then begin
      MotherState^.DyingAfterTrueException:= True;
      if not MotherState^.CallStackLogged then begin
        _crash_details:= '';
        i:=0;
        a:= get_frame;
        while Assigned(a) do begin
          ca:= get_caller_addr(a);
          {ignore the first two callers. These always are: 0). call to this
            procedure from Die() or TryWrap() and 1). Call to Die itself from the
            except... block}
          if Assigned(ca) then begin
            if i = 1 then _crash_details+= #10#13'Call stack:';
            if i >= 1 then _crash_details+= #10#13'  ' + ShortExpAddr(ca);
            inc(i);
          end
          else Break;
          if i> MAX_STACK_FRAMES_DUMP then break;
          a:= get_caller_frame(a);
        end;
        with MotherState^ do begin
          if _crash_Details <> '' //DeveloperMode or DebugMode
            then _dyell+= #10#13#10#13 + _crash_Details;
          CallStackLogged:= Yes;
        end;
      end;
    end;
    _HostDyellW(PWideChar(_dyell));
    with MotherState^ do
      if not DeveloperMode and not DebugMode and not GenericDyingYellsLogged
        then AddLog('%0'#10#13'<---------------------->',[_crash_details]);
    if Assigned(OldSafeCallErrorProc) then OldSafeCallErrorProc(error, addr);
  *)
  end;




  Procedure AddLog(S: Ansistring; Param: array of const);
  begin
    AddLog(AnsiToWide(S), Param);
  end;

    var _2log: WideString;
  Procedure AddLog(U: WideString; Param: array of const);
  begin
    {$ifdef windows}
      if MotherState^.MainThreadId <> GetCurrentThreadId() then begin
        ThreadManager.PassLog(PervertedFormat(u, Param));
        exit;
      end;
    {$else}
      {$fatal not implemented yet}
    {$endif}
    _2log:=PervertedFormat(u, Param);
    _HostLogW(PWideChar(_2log));
   // AfterEfCheck; //whoops... This caused an infinite exception loop.
  end;

  Procedure AddLog(mID: TMessageID; Param: array of const);
  begin
    {$ifdef windows}
      if MotherState^.MainThreadId <> GetCurrentThreadId() then begin
        ThreadManager.PassLog(MsgFormat(mID, Param));
        exit;
      end;
    {$else}
      {$fatal not implemented yet}
    {$endif}
    _2log:=MsgFormat(mID, Param);
   _HostLogW(PWideChar(_2log));
  // AfterEfCheck;
  end;

  Procedure AddLog(mID: TMessageID);
  begin
    AddLog(mID, []);
  end;

  Procedure AddLog(S: AnsiString);
  begin
    AddLog(AnsiToWide(S), []);
  end;

  Procedure AddLog(U: WideString);
  begin
    AddLog(U, []);
  end;
  
{$ifndef unix}
function mo_ReportDebugBacktrack(addr: pointer): WideString;
begin
  Result:=ExpExpAddress(addr);
end;

Procedure mo_CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
Var
  Message : WideString;
  i : longint;
begin
  Message:= 'An unhandled exception occurred at ' + HexStr(Ptrint(Addr),sizeof(PtrInt)*2) + ' :'#10#13;
  if Obj is exception
    then Message+= '  ' + Exception(Obj).ClassName+' : '+Exception(Obj).Message
    else Message+= '  Exception object '{ + Obj.ClassName} + ' is not of class Exception.';
  Message+= #10#13 + BackTraceStrFunc(Addr);
{  if (FrameCount>0) then
    begin
      for i:=0 to FrameCount-1 do
        Message+= #10#13 + BackTraceStrFunc(Frames[i]);
    end;}
  _HostDyellW(PWideChar(Message));
  Halt(217);
end;

{  Procedure CgeCatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);
  begin
    Die('An unhandled exception occurred at %0'#10#13'  %1:  %2', [Addr, Exception(Obj).ClassName, Exception(Obj).Message]);
    Writeln(stdout,'An unhandled exception occurred at $',HexStr(Ptrint(Addr),sizeof(PtrInt)*2),' :');
    if Obj is exception
      then Die('An unhandled exception occurred at %0'#10#13'  %1:  %2', [Addr, Exception(Obj).ClassName, Exception(Obj).Message])
      else Die('An unhandled exception occurred at %0', [Addr]);
  end;
     }
{$endif}

procedure PlaySound(wawfilename: ansistring);
begin
  _PlaySound(PAnsiChar(wawfilename));
  AfterEfCheck;
end;


