{
    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 exception reporting routine

 **********************************************************************}
 
 
 // Requires the "chelinfo" unit ! and -gw to include the dwarf 2 debugging information!

  function LimitMessage(m: ansistring; limit1, limit: integer; startspace: ansistring): ansistring;
  var i, j, L: integer;
  begin
    Result:=m;
    if length(Result) <= limit1 then Exit;
    limit-= length(startspace);
    L:= limit1;
    j:=1;
    repeat
      i:=0;
      while (Result[L - i] <> ' ') and ((L - i) > (j + 10)) do inc(i);
      L-= i;
      Result:=Copy(Result, 1, L) + #10#13 + startspace + Copy(Result, L + 1, Length(Result) - L);
      j:= L + 2 + length(startspace);
      L:= j + limit;
    until L >= length(Result);
  end;

  function _ExpExpAddress(addr: pointer; brief: boolean): WideString;
  var
 {$ifdef win32}
    TST: array[0..Max_Path] of WideChar;
    BA: pointer;
    Tmm: TMemoryBasicInformation;
 {$endif}
 {$ifdef cpu32}
   src: ansistring;
 {$else}
   LineInfoError: WideString;
   src, func: shortstring;
 {$endif}
    exe: ansistring;
    Wexe, Wsrc: WideString;
    line, column: longint;
    a: pointer;
  begin
    {$ifdef cpu32}
      //chelinfo
      GetLineInfo(addr, exe, src, line, column);
    {$else}
      //lineinfo from Free Pascal RTL
      //function GetLineInfo(addr:ptruint;var func,source:string;var line:longint) : boolean;
      exe:= '';
      column:= -1;
      if GetLineInfo(ptruint(addr), func, src, line) then begin
        Wexe:= func;
      end
      else begin
        LineInfoError:= RuEn('причина неизвестна', 'reason unknown');
        line:= -1;
      end;
    {$endif}
    Wexe:= ExtractFileName(exe);
    Wsrc:= ExtractFileName(src);
    if (line < 1) then begin
      if (exe = '') then begin
      {$ifdef cpu32}
        {$ifdef windows}
          if (VirtualQuery(addr, @Tmm, SizeOf(Tmm)) = SizeOf(Tmm))
            and (Tmm.State <> MEM_COMMIT)
          then Wexe:= RuEn(' в <невыделенной памяти>',' in <unallocated space>')
          else
        {$endif}
            Wexe:=RuEn(' в <неизвестном исполняемом модуле>',' in <unknown executable module>')
        {$else}
      {$endif}
      end;
      if Length(LineInfoError) > 30 then LineInfoError:= '  '#10#13 + LineInfoError;
      if brief then  Result:= PervertedFormat(RuEn(
          '%0 в %1',
          '%0 in %1')
          , [addr, Wexe])
      else Result:= PervertedFormat(RuEn(
          'по адресу %0 в %1'#10#13'  (нет отладочной информации: %2)',
          'at %0 in %1'#10#13'  (no debug info available: %2)')
          , [addr, Wexe, LineInfoError])
    end
    else begin
      if column < 1
      then Result:= PervertedFormat(RuEn(
        '%0:%1 в %2',
        '%0:%1 in %2'),
        [ExtractFileName(Wsrc), line, Wexe])
      else Result:= PervertedFormat(RuEn(
        '%0:%1:%3 в %2',
        '%0:%1:%3 in %2'),
        [ExtractFileName(Wsrc), line, Wexe, column]);
    end;
  end;

  function ExpExpAddress(addr: pointer): WideString;
  begin
    Result:= _ExpExpAddress(addr, false)
  end;

  function ShortExpAddr(addr: pointer): WideString;
  begin
    Result:= _ExpExpAddress(addr, true)
  end;



  {$ifdef cgekernel}
    function MsgFormat(M: TMessageId; Param: array of const): WideString;
    begin
      Result:= PervertedFormat(MessageContainer[M], Param);
    end;

    function MsgRaw(M: TMessageID): WideString;
    begin
      Result:= MessageContainer[M];
    end;
  {$endif}
  

  function TellException(E: Exception): WideString;
  var
    m, n: widestring;
  begin
   if not (E is Exception) then Exit ('Not an Exception');
   try
     if E is EAbstractERROR then Exit(MsgRaw(MI_EABSTRACT_EXPLAIN));
     if E is EAccessViolation then begin
       if cardinal(ExceptAddr) < 1024
         then Exit(MsgRaw(MI_ET_ACCESS_VIOLATION_CALL_TO_0))
 //        else Exit(MsgFormat(MI_ET_ACCESS_VIOLATION, [ExpExpAddress()]))
     end;
   //  Result:= MsgFormat(MI_SIMPLE_EXCEPTION_TALE, [trim(E.ClassName), AnsiToWide(E.Message)]);
     n:= trim(E.ClassName);
     m:= AnsiToWide(LimitMessage(E. Message, 60 - length(n), 60, '  '));
     Result:= PervertedFormat(RuEn(
        '%0: %1'#10#13'  %2',
        '%0: %1'#10#13'  %2'),
        [n, m, ExpExpAddress(ExceptAddr())]);
   except
     Result:='Crashed trying to explain exception:'#10#13'  ' + (ExceptObject as Exception).Message;
   end;
  end;

 function SehHackTellExceptionAddress(a: dword): WideString;
 begin
  Result:= ExpExpAddress(pointer(a));
 end;

//Alas, this sort of extended information is only provided by Delphi :(
(*
  {$ifdef win32}
  //function VirtualQuery(adr, buffer: LPCVOID; dwLength:DWORD):DWORD; external 'kernel32' name 'VirtualQuery';
  {$endif}

  function ToldMemRgn(ptr: pointer): WideString;

 {$IFNDEF WIN32}
  begin
    Result:='';//AnsiToWide('ChebLib''s tale-telling memory regions is implemented only for 32-bit Micro$oft Windows.');
  end;
 {$ELSE WIN32}
  var
    S: WideString;
    mm, ml, mr: _MEMORY_BASIC_INFORMATION;
    A: CARDINAL;

    function DescMemProp(AB, Protect, State, _Type: integer): WideString;
    var TST: array[0..Max_Path] of char;
    begin
      Case State of
       MEM_RESERVE: Result:=RuEn('зарезервирована', 'reserved');
       MEM_FREE: Result:= RuEn('свободна', 'free');
       MEM_COMMIT: begin
          if GetModuleFileName(THandle(AB), TST, SizeOf(TST)) <> 0
            then Result:= PervertedFormat(RuEn('выделена %0','committed by %0'), [ExtractFileName(PChar(@TST))])
            else Result:= PervertedFormat(RuEn('выделена','committed'), [ExtractFileName(PChar(@TST))]);

          If (_Type <> MEM_PRIVATE) then
            Result+= RuEn(', общая',', shared');
          If (Protect and PAGE_NOCACHE > 0) then
            Result+= RuEn(', некэшируемая',', non-cached');
          If (Protect and PAGE_GUARD > 0) then
            Result+= RuEn(', охраняемая',', guarded');
          Result+= RuEn(', доступ: ',', access: ');
          Protect:= Protect and not (PAGE_NOCACHE + PAGE_GUARD);
          case Protect of
            PAGE_READONLY: Result+= RuEn('только чтение','read only');
            PAGE_READWRITE: Result+= RuEn('чтение/запись','read/write');
            PAGE_WRITECOPY: Result+= RuEn('копируется при записи','copy-on-write');
            PAGE_EXECUTE: Result+= RuEn('только выполнение кода','execute only');
            PAGE_EXECUTE_READ: Result+= RuEn('чтение и выполнение кода','read and execute');
            PAGE_EXECUTE_READWRITE: Result+= RuEn('полный','full');
            PAGE_EXECUTE_WRITECOPY: Result+= RuEn('выполнение кода/копируется при записи','execute/copy-on-write');
            PAGE_NOACCESS: Result+= RuEn('запрещён','denied');
          else
            result+= RuEn('неизвестен','unknown');
          end;
        end;
      end;
    end;
  begin
    Result:='';
    A:=cardinal(ptr);
    if VirtualQuery(Pointer(A), @mm, SizeOf(mm)) <> SizeOf(mm)then Exit;
//    if (cardinal(mm.BaseAddress) >= 0) then
      if VirtualQuery(Pointer(cardinal(mm.BaseAddress)-1), @ml, SizeOf(ml))
      = SizeOf(ml)
      then
        Result:=PervertedFormat('  %0h..%1h (%2K): %3;'#10#13,
          [ml.BaseAddress, ml.BaseAddress + ml.RegionSize-1, ml.RegionSize div 1024,
           DescMemProp(cardinal(ml.AllocationBase), ml.Protect,ml.State, ml._Type)]);
        Result+= PervertedFormat('  %0h..%1h (%2K): %3',
          [mm.BaseAddress, mm.BaseAddress + mm.RegionSize - 1, mm.RegionSize div 1024,
           DescMemProp(cardinal(mm.AllocationBase),mm.Protect, mm.State, mm._Type)]);
    if (cardinal(mm.BaseAddress) - 1 + mm.RegionSize  < $FFFFFFFE) then
      if VirtualQuery(Pointer(cardinal(mm.BaseAddress) + mm.RegionSize), @mr, SizeOf(mr)) = SizeOf(mr)
      then begin
        Result+= PervertedFormat(';'#10#13'  %0h..%1h (%2K): %3',
          [mr.BaseAddress, mr.BaseAddress + mr.RegionSize, mr.RegionSize div 1024,
           DescMemProp(cardinal(mr.AllocationBase), mr.Protect,mr.State,mr._Type)]);
      end;
    Result+= '.';
  end;
 {$ENDIF WIN32}




 {$IFDEF WIN32}
const
  //oops.. missing in the FreePascal RTL..
  EXCEPTION_IN_PAGE_ERROR = $C0000006;
  EXCEPTION_ILLEGAL_INSTRUCTION = $C000001D;


 {$ENDIF WIN32}
*)

