{$MODE OBJFPC} { -*- text -*- }
{$INCLUDE settings.inc}
unit exceptions;

interface

uses
   sysutils, baseunix;

type
   EKernelError = class(Exception)
      constructor Create(AErrorCode: cint);
   end;
   ESocketError = class(Exception)
      constructor Create(AErrorCode: cint);
   end;
   ESyntaxError = class(Exception)
   end;

procedure ReportException();
{$IFDEF DEBUG} function GetStackTrace(): AnsiString; {$ENDIF}

type
   TXXX = type Pointer;

function XXX: Variant; unimplemented;

implementation

uses
   errors;

const
   KernelErrorMsg: String = 'kernel error %d: %s';
   SocketErrorMsg: String = 'socket error %d: %s';

constructor EKernelError.Create(AErrorCode: cint);
begin
   inherited Create(Format(KernelErrorMsg, [AErrorCode, StrError(AErrorCode)]));
end;

constructor ESocketError.Create(AErrorCode: cint);
begin
   inherited Create(Format(SocketErrorMsg, [AErrorCode, StrError(AErrorCode)]));
end;

procedure WriteBacktrace(Address: Pointer; Frames: PPointer; FrameCount: Cardinal);
var
   FrameNumber: Cardinal;
begin
   WriteLn(BackTraceStrFunc(Address));
   if (FrameCount > 0) then
      for FrameNumber := 0 to FrameCount-1 do
         WriteLn(BackTraceStrFunc(Frames[FrameNumber]));
end;

procedure ReportException();
begin
   Assert(Assigned(RaiseList));
   Assert(Assigned(RaiseList^.FObject));
   if (RaiseList^.FObject is Exception) then
      Writeln((RaiseList^.FObject as Exception).Message);
   WriteBacktrace(RaiseList^.Addr, RaiseList^.Frames, RaiseList^.FrameCount);
end;

{$WARNINGS OFF}
function XXX: Variant;
begin
   Assert(False, 'Not Implemented');
   raise Exception.Create('Not Implemented');
end;
{$WARNINGS ON}

procedure AssertionHandler(const Message, FileName: ShortString; LineNo: Longint; ErrorAddr: Pointer);
var
   CompleteMessage: AnsiString;
begin
   if (Message <> '') then
      CompleteMessage := 'Assertion "' + Message + '" failed on line ' + IntToStr(LineNo) + ' of ' + FileName
   else
      CompleteMessage := 'Assertion failed on line ' + IntToStr(LineNo) + ' of ' + FileName;
   {$IFDEF DEBUG}
   Writeln('Raising assertion: ', CompleteMessage);
   {$ENDIF}
   raise EAssertionFailed.Create(CompleteMessage) at Get_Caller_Addr(ErrorAddr), Get_Caller_Frame(ErrorAddr);
end;

{$IFDEF DEBUG}
function GetStackTrace(): AnsiString;
// the following is a verbatim copy from http://wiki.freepascal.org/Logging_exceptions
var
  I: Longint;
  prevbp: Pointer;
  CallerFrame,
  CallerAddress,
  bp: Pointer;
  Report: string;
const
  MaxDepth = 20;
begin
  Report := '';
  bp := get_frame;
  // This trick skip SendCallstack item
  // bp:= get_caller_frame(get_frame);
  try
    prevbp := bp - 1;
    I := 0;
    while bp > prevbp do begin
       CallerAddress := get_caller_addr(bp);
       CallerFrame := get_caller_frame(bp);
       if (CallerAddress = nil) then
         Break;
       Report := Report + BackTraceStrFunc(CallerAddress) + LineEnding;
       Inc(I);
       if (I >= MaxDepth) or (CallerFrame = nil) then
         Break;
       prevbp := bp;
       bp := CallerFrame;
     end;
   except
     { prevent endless dump if an exception occured }
   end;
   // end of copy from http://wiki.freepascal.org/Logging_exceptions
   Result := Report;
end;
{$ENDIF}

initialization
   AssertErrorProc := @AssertionHandler;
end.