mop/patches/fpc/fpc222aborting.patch

   1 --- fpc-2.2.2/fpcsrc/rtl/inc/system.inc.ori     2009-03-16 16:28:29.000000000 +0100
   2 +++ fpc-2.2.2/fpcsrc/rtl/inc/system.inc 2009-03-16 18:29:45.000000000 +0100
   3 @@ -585,27 +585,65 @@
   4                               Miscellaneous
   5  *****************************************************************************}
   6
   7 +{ MOP 2009 patch: call sigabort when -gl was used in compilation }
   8 +const
   9 +  DontHaltInHandleError : boolean = false;
  10 +
  11 +function IsCompiledWithGl : boolean;
  12 +begin
  13 +  { -gl modifies BackTraceStrFunc to point to lineinfo unit }
  14 +  IsCompiledWithGl := BackTraceStrFunc <> @SysBackTraceStr;
  15 +end;
  16 +
  17 +procedure InternalExit; forward;
  18 +{ We define next method as a macro, because we do not want to
  19 +  show it when a stack is dumped. Because of the same reason
  20 +  we call SYSCALL_KILL ourselves in assembler code. }
  21 +{$MACRO ON}
  22 +{$define DumpStackAndAbort:=
  23 +  begin
  24 +    InternalExit;
  25 +    asm
  26 +      movl $20, %eax;        { SYSCALL_GETPID as first argument }
  27 +      int $0x80;             { GETPID -> eax }
  28 +      movl %eax, %ebx;       { PID as second argument }
  29 +      movl $37, %eax;        { SYSCALL_KILL as first argument }
  30 +      movl $6, %ecx;         { SIGABRT as third argument }
  31 +      int $0x80;             { KILL }
  32 +    end;
  33 +  end
  34 +}
  35 +{ MOP 2009 patch ends }
  36 +
  37  procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; compilerproc;
  38  begin
  39 +  if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  40    HandleErrorFrame(201,get_frame);
  41 +  DumpStackAndAbort;                                      { MOP 2009 patch }
  42  end;
  43
  44
  45  procedure fpc_divbyzero;[public,alias:'FPC_DIVBYZERO']; compilerproc;
  46  begin
  47 +  if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  48    HandleErrorFrame(200,get_frame);
  49 +  DumpStackAndAbort;                                      { MOP 2009 patch }
  50  end;
  51
  52
  53  procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; compilerproc;
  54  begin
  55 +  if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  56    HandleErrorFrame(215,get_frame);
  57 +  DumpStackAndAbort;                                      { MOP 2009 patch }
  58  end;
  59
  60
  61  procedure fpc_threaderror; [public,alias:'FPC_THREADERROR'];
  62  begin
  63 +  if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  64    HandleErrorFrame(6,get_frame);
  65 +  DumpStackAndAbort;                                      { MOP 2009 patch }
  66  end;
  67
  68
  69 @@ -619,7 +657,9 @@
  70     begin
  71       l:=HInOutRes^;
  72       HInOutRes^:=0;
  73 +     if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  74       HandleErrorFrame(l,get_frame);
  75 +     DumpStackAndAbort;                                      { MOP 2009 patch }
  76     end;
  77  end;
  78
  79 @@ -648,7 +688,9 @@
  80      begin
  81        if assigned(SafeCallErrorProc) then
  82          SafeCallErrorProc(res,get_frame);
  83 +      if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  84        HandleErrorFrame(229,get_frame);
  85 +      DumpStackAndAbort;                                      { MOP 2009 patch }
  86      end;
  87    result:=res;
  88  end;
  89 @@ -680,7 +722,9 @@
  90    if (c <= StackBottom) then
  91     begin
  92       StackError:=true;
  93 +     if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
  94       HandleError(202);
  95 +     DumpStackAndAbort;                                      { MOP 2009 patch }
  96     end;
  97  end;
  98  {$IFDEF STACKCHECK}
  99 @@ -862,6 +906,8 @@
 100    errorcode:=word(Errno);
 101    erroraddr:=addr;
 102    errorbase:=frame;
 103 +  if DontHaltInHandleError then exit;           { MOP 2009 patch }
 104 +  if IsCompiledWithGl then DumpStackAndAbort;   { MOP 2009 patch }
 105  {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
 106    if ExceptAddrStack <> nil then
 107      raise TObject(nil) at addr,frame;
 108 @@ -903,6 +949,7 @@
 109    errorcode:=w;
 110    erroraddr:=get_caller_addr(get_frame);
 111    errorbase:=get_caller_frame(get_frame);
 112 +  if IsCompiledWithGl then DumpStackAndAbort;   { MOP 2009 patch }
 113  {$ifdef FPC_HAS_FEATURE_EXITCODE}
 114    if errorcode <= maxExitCode then
 115      halt(errorcode)
 116 @@ -1148,7 +1195,9 @@
 117  begin
 118    If pointer(AbstractErrorProc)<>nil then
 119      AbstractErrorProc();
 120 +  if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
 121    HandleErrorFrame(211,get_frame);
 122 +  DumpStackAndAbort;                                      { MOP 2009 patch }
 123  end;
 124
 125
 126 @@ -1156,8 +1205,11 @@
 127  begin
 128    if pointer(AssertErrorProc)<>nil then
 129      AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
 130 -  else
 131 +  else begin
 132 +    if IsCompiledWithGl then DontHaltInHandleError := true; { MOP 2009 patch }
 133      HandleErrorFrame(227,get_frame);
 134 +    DumpStackAndAbort;                                      { MOP 2009 patch }
 135 +  end
 136  end;
 137
 138