View Issue Details

IDProjectCategoryView StatusLast Update
0025312FPCCompilerpublic2019-10-11 19:32
ReporterAndrey ParamonovAssigned ToSven Barth 
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
Platformw32OSMS Windows 7OS Version7
Product Version2.6.2Product Build2013/02/12 
Target VersionFixed in Version 
Summary0025312: Unhandled exception when using w32 fiber API
DescriptionI'm trying to implement coroutine class using w32 fiber API (see http://msdn.microsoft.com/en-us/library/ms682661.aspx). In the attached minimal example worker fiber is created. GetNext procedure is called from caller (outer) fiber and switches execution flow into worker (inner) fiber, while Yield is called from the worker fiber and switched back into caller fiber. An exception is thrown inside worker fiber which should be always caught by try-except statement (program should output "Gotcha"). However, exception is unhandled.
Steps To Reproduce>fpc fiberdemo.lpr
Free Pascal Compiler version 2.6.2 [2013/02/12] for i386
Copyright (c) 1993-2012 by Florian Klaempfl and others
Target OS: Win32 for i386
Compiling fiberdemo.lpr
Linking fiberdemo.exe
87 lines compiled, 0.1 sec , 61104 bytes code, 13180 bytes data

>fiberdemo.exe
exception at 00401888:
Test.
Additional InformationCode compiles and runs on Delphi just fine:
>fiberdemo.exe
Gotcha
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • fiberdemo.lpr (1,587 bytes)
  • fiberdemo_int.zip (1,803 bytes)
  • iterimpl.pas (4,716 bytes)
    unit iterimpl;
    
    // Delphi debugger always stops on exception handler code when using
    // F8 (Step Over). It is especially annoying for iterators because
    // in case of EStopIteration one cannot easily walk up the stack and
    // resume execution.
    // Fix it by disabling debug info for this unit.
    {$D-}
    
    interface
    
    uses
      sysutils;
    
    const
      cDefStackSize = 64*1024;
    
    type
      TFiberIterator = class
      private
        FWorkerContext: Pointer;
        FCallerContext: Pointer;
    
        FIsIterating: Boolean;  // is inside Iterate
        FNeedStop: Boolean;     // will forcibly finish Iterate by throwing EStopIteration
        FNeedReset: Boolean;    // will restart Iterate
        FFatalException: TObject;
        FValue: Pointer;
    
        procedure IterateProc; stdcall;
        function AcquireFatalException: TObject;
    
      protected
        procedure DoIterate; virtual;
        procedure Iterate; virtual; abstract;
        procedure SwitchToWorker;
        procedure SwitchToCaller;
    
      public
        constructor Create(AStackSize: Integer =cDefStackSize);
        destructor Destroy; override;
        procedure Yield(AValue: Pointer);
        function GetNext(out AValue: Pointer): Boolean; virtual;
        procedure Reset; virtual;
      end;
    
      // *optional* way to stop iterator early
      // do not catch
      EStopIteration = class(Exception)
      public
        constructor Create;
      end;
    
    implementation
    
    {$IFDEF FPC}
    {$ASMMODE intel}
    {$ENDIF}
    
    uses
      windows, jwawinbase;
    
    function GetCurrentFiber: PVOID;
    asm
      mov eax, gs:[$20]
    end;
    
    function SetThreadStackGuarantee(var StackSizeInBytes: PULONG): LONGBOOL;
      external 'kernel32.dll' name 'SetThreadStackGuarantee';
    
    function CreateEmptyContext: Pointer;
    begin
      ConvertThreadToFiber(nil);
      Result := GetCurrentFiber;
    end;
    
    function CreateContext(AStackSize: Cardinal;
      AEntryProc, AEntryProcParam: Pointer): Pointer;
    begin
      Result := CreateFiber(AStackSize, AEntryProc, AEntryProcParam);
    end;
    
    procedure FreeContext(var AContext: Pointer);
    begin
      DeleteFiber(AContext);
      AContext := nil;
    end;
    
    procedure SwitchContext(ASwitchFrom, ASwitchTo: Pointer);
    begin
      SwitchToFiber(ASwitchTo);
    end;
    
    procedure InstallStackProtection(AContext: Pointer);
    var
      Size: Cardinal;
      PSize: PCardinal;
    begin
      Size := 4096;
      PSize := @Size;
      SetThreadStackGuarantee(PSize);
    end;
    
    { TFiberIterator }
    constructor TFiberIterator.Create(AStackSize: Integer);
    begin
      inherited Create;
      FCallerContext := CreateEmptyContext;
      FWorkerContext := CreateContext(AStackSize, @TFiberIterator.IterateProc, Self);
    end;
    
    destructor TFiberIterator.Destroy;
    begin
      if FIsIterating then
      begin
        FNeedStop := True;
        SwitchToWorker;
      end;
      FreeContext(FWorkerContext);
      //FreeContext(FCallerContext);
      FFatalException.Free;
      inherited;
    end;
    
    procedure TFiberIterator.Reset;
    begin
      if FIsIterating then
        FNeedStop := True;
      FNeedReset := True;
    end;
    
    function TFiberIterator.AcquireFatalException: TObject;
    begin
      Result := FFatalException;
      FFatalException := nil;
    end;
    
    procedure TFiberIterator.DoIterate;
    begin
      Iterate;
    end;
    
    procedure TFiberIterator.IterateProc; stdcall;
    begin
      try
        while True do
        begin
          FNeedReset := False;
          InstallStackProtection(PContext(FWorkerContext));
    
          // iterate
          FIsIterating := True;
          try
            try
              DoIterate;
            except
              on EStopIteration do;
                // pass
              on E: Exception do
                FFatalException := AcquireExceptionObject;
            end;
          finally
            FIsIterating := False;
            FNeedStop := False;
          end;
    
          // keep context alive
          while True do
            if FNeedReset then
              Break
            else
              Yield(nil);
        end;
      except
        // should never get here
        on E: Exception do
          ShowException(E, ExceptAddr);
      end;
    end;
    
    procedure TFiberIterator.Yield(AValue: Pointer);
    // executed in worker context
    begin
      FValue := AValue;
      SwitchToCaller;
      if FIsIterating and FNeedStop then
        raise EStopIteration.Create;
    end;
    
    function TFiberIterator.GetNext(out AValue: Pointer): Boolean;
    // executed in caller context
    begin
      SwitchToWorker;
      if FFatalException <> nil then
        raise AcquireFatalException;
      Result := FIsIterating;
      AValue := FValue;
    end;
    
    procedure TFiberIterator.SwitchToCaller;
    begin
      SwitchContext(FWorkerContext, FCallerContext);
    end;
    
    procedure TFiberIterator.SwitchToWorker;
    begin
      SwitchContext(FCallerContext, FWorkerContext);
    end;
    
    { EStopIteration }
    constructor EStopIteration.Create;
    begin
      inherited Create('Stop iteration');
    end;
    
    end.
    
    
    iterimpl.pas (4,716 bytes)
  • baseiter.pas (4,428 bytes)
    unit baseiter;
    
    interface
    
    uses
      iterimpl;
    
    type
      // Base iterator interfaces
      IIterator<T> = interface
        function Next(out AValue: T): Boolean;
      end;
    
      IGenericIterator = IIterator<Pointer>;
      IStringIterator = IIterator<String>;
      IIntegerIterator = IIterator<Integer>;
      IFloatIterator = IIterator<Double>;
    
      IResettable = interface
      ['{3CC2EE46-A542-4954-BCC0-523C68B60089}']
        procedure Reset;
      end;
    
    // --------
    
      // Base iterator classes
      TIterator<T> = class(TInterfacedObject, IIterator<T>)
      private
        FCurrent: T;
        function NopGetCurrent: TObject;
      public
        function Next(out AValue: T): Boolean; virtual; abstract;
        procedure Reset; virtual;
        // IEnumerator
        function MoveNext: Boolean;
        function GetCurrent: T;
        property Current: T read GetCurrent;
        // for-in support
        function GetEnumerator: TIterator<T>;
        function Copy: TIterator<T>;
      end;
    
      TGenericIterator = TIterator<Pointer>;
      TStringIterator = TIterator<String>;
      TIntegerIterator = TIterator<Integer>;
      TFloatIterator = TIterator<Double>;
    
    // --------
    
      // Base fiber iterator classes
      TBaseIterator<T> = class(TIterator<T>, IResettable)
      private
        FIter: TFiberIterator;
      protected
        procedure Yield(const AValue: T);
        procedure Iterate; virtual; //abstract;
      public
        constructor Create(AStackSize: Integer =cDefStackSize);
        destructor Destroy; override;
        function Next(out AValue: T): Boolean; override; final;
        procedure Reset; override; final;
      end;
    
      TBaseGenericIterator = TBaseIterator<Pointer>;
      TBaseStringIterator = TBaseIterator<String>;
      TBaseIntegerIterator = TBaseIterator<Integer>;
      TBaseFloatIterator = TBaseIterator<Double>;
    
      // *optional* way to stop iterator early
      // do not catch
      EStopIteration = iterimpl.EStopIteration;
    
    // --------
    
    type
      TExtIterator<T> = class(TIterator<T>)
      private
        FIter: TIterator<T>;
      public
        constructor Create(AIter: TIterator<T>);
        function Next(out AValue: T): Boolean; override;
        procedure Reset; override;
      end;
    
      TIterateMethod = procedure of object;
    
    function CreateFiberIterator(ADoIterate: TIterateMethod;
      AStackSize: Integer): TFiberIterator;
    
    implementation
    
    type
      TMethodIterator = class(TFiberIterator)
      private
        FDoIterate: TIterateMethod;
      protected
        procedure Iterate; override;
      public
        constructor Create(ADoIterate: TIterateMethod;
          AStackSize: Integer);
      end;
    
    { TExtIterator<T> }
    constructor TExtIterator<T>.Create(AIter: TIterator<T>);
    begin
      inherited Create;
      FIter := AIter;
    end;
    
    function TExtIterator<T>.Next(out AValue: T): Boolean;
    begin
      Result := FIter.Next(AValue);
    end;
    
    procedure TExtIterator<T>.Reset;
    begin
      FIter.Reset;
    end;
    
    { TIterator<T> }
    function TIterator<T>.MoveNext: Boolean;
    begin
      Result := Next(FCurrent);
    end;
    
    function TIterator<T>.NopGetCurrent: TObject;
    begin
      Result := nil;
    end;
    
    function TIterator<T>.GetCurrent: T;
    begin
      Result := FCurrent;
    end;
    
    procedure TIterator<T>.Reset;
    begin
      // do nothing
    end;
    
    function TIterator<T>.GetEnumerator: TIterator<T>;
    begin
      Result := Self;
    end;
    
    function TIterator<T>.Copy: TIterator<T>;
    begin
      Result := TExtIterator<T>.Create(Self);
    end;
    
    function CreateFiberIterator(ADoIterate: TIterateMethod;
      AStackSize: Integer): TFiberIterator;
    begin
      Result := TMethodIterator.Create(ADoIterate, AStackSize);
    end;
    
    { TMethodIterator }
    constructor TMethodIterator.Create(ADoIterate: TIterateMethod;
      AStackSize: Integer);
    begin
      inherited Create(AStackSize);
      FDoIterate := ADoIterate;
    end;
    
    procedure TMethodIterator.Iterate;
    begin
      FDoIterate;
    end;
    
    { TBaseIterator<T> }
    constructor TBaseIterator<T>.Create(AStackSize: Integer);
    begin
      inherited Create;
      FIter := CreateFiberIterator(Iterate, AStackSize);
    end;
    
    destructor TBaseIterator<T>.Destroy;
    begin
      FIter.Free;
      inherited;
    end;
    
    procedure TBaseIterator<T>.Yield(const AValue: T);
    begin
      FIter.Yield(Addr(AValue));
    end;
    
    procedure TBaseIterator<T>.Iterate;
    begin
    
    end;
    
    function TBaseIterator<T>.Next(out AValue: T): Boolean;
    var
      Value: Pointer;
    begin
      Result := FIter.GetNext(Value);
      if Value <> nil then
        AValue := T(Value^);
    end;
    
    procedure TBaseIterator<T>.Reset;
    begin
      FIter.Reset;
    end;
    
    end.
    
    
    baseiter.pas (4,428 bytes)
  • iterdemo.lpr (1,284 bytes)
  • except.inc_win32.patch (954 bytes)
    Index: except.inc
    ===================================================================
    --- except.inc	(revision 26110)
    +++ except.inc	(working copy)
    @@ -236,6 +236,10 @@
     Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
     var
       hp : ^PExceptAddr;
    +{$ifdef win32}  
    +  prev,curr : PExceptAddr;
    +  cstack, TopStack : PtrUInt;
    +{$endif}  
     begin
     {$ifdef excdebug}
       writeln ('In Popaddrstack');
    @@ -250,7 +254,31 @@
         end
       else
         begin
    +	  {$ifdef win32}
    +	  asm 
    +	    mov %ebp,cstack
    +		mov %fs:(4),%eax
    +		mov %eax,TopStack
    +	  end;
    +	  prev:=hp^;
    +	  curr:=prev;
    +	  while curr<>nil do
    +	  begin
    +	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
    +		begin
    +		  if curr=prev then
    +		    hp^:=hp^^.Next
    +			else
    +			  prev^.Next:=curr^.Next;
    +		  break;
    +		end else begin
    +		  prev:=curr;
    +		  curr:=curr^.Next;
    +		end;
    +	  end;
    +	  {$else}
           hp^:=hp^^.Next;
    +	  {$endif}
         end;
     end;
     
    
  • except.inc_win32_new.patch (2,014 bytes)
    Index: except.inc
    ===================================================================
    --- except.inc	(revision 26112)
    +++ except.inc	(working copy)
    @@ -48,6 +48,10 @@
       ExceptAddrStack   : PExceptAddr;
       ExceptObjectStack : PExceptObject;
       ExceptTryLevel    : longint;
    +  {$ifdef win32}
    +  ExceptAddrSkip    : PExceptAddr;
    +  SkipAddrCount     : Integer;
    +  {$endif}
     
     Function RaiseList : PExceptObject;
     begin
    @@ -236,6 +240,10 @@
     Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
     var
       hp : ^PExceptAddr;
    +{$ifdef win32}  
    +  prev,curr : PExceptAddr;
    +  cstack, TopStack : PtrUInt;
    +{$endif}  
     begin
     {$ifdef excdebug}
       writeln ('In Popaddrstack');
    @@ -250,7 +258,56 @@
         end
       else
         begin
    +	  {$ifdef win32}
    +	  asm 
    +	    mov %ebp,cstack
    +		mov %fs:(4),%eax
    +		mov %eax,TopStack
    +	  end;
    +	  // remove skiped poping
    +	  if (ExceptAddrSkip<>nil) then
    +	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
    +	  begin
    +	    ExceptAddrSkip:=nil;
    +		while SkipAddrCount>0 do begin
    +		  hp^:=hp^^.Next;
    +		  Dec(SkipAddrCount);
    +		  if hp^=nil then
    +		    break;
    +		end;
    +	  end;
    +	  // start traverse
    +	  prev:=hp^;	  
    +	  curr:=prev;
    +	  while curr<>nil do
    +	  begin
    +	    // exceptstack in stack range
    +	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
    +		begin
    +		  if curr=prev then
    +		    hp^:=hp^^.Next
    +			else
    +			  prev^.Next:=curr^.Next;
    +		  break;
    +		end else begin
    +		  // prevent main thread's other thread poping
    +		  if PtrUInt(curr)>TopStack then
    +		  begin
    +		    if ExceptAddrSkip=nil then
    +			begin
    +		      ExceptAddrSkip:=Pointer(cstack);
    +			  SkipAddrCount:=1;
    +			end else
    +			  Inc(SkipAddrCount);
    +		    break;
    +		  end;
    +		  prev:=curr;
    +		  curr:=curr^.Next;
    +		end;
    +	  end;
    +	  {$else}
           hp^:=hp^^.Next;
    +	  {$endif}
         end;
     end;
     
    @@ -394,6 +451,9 @@
     begin
       ExceptObjectstack:=Nil;
       ExceptAddrStack:=Nil;
    +  {$ifdef win32}
    +  ExceptAddrSkip:=Nil;
    +  {$endif}
     end;
     
     
    
  • iterdemo_w32_work.zip (45,795 bytes)
  • fpc_win32_per_thread_seh.zip (16,723 bytes)
  • fpc_win32_per_thread.patch (7,480 bytes)
    Index: rtl/i386/setjump.inc
    ===================================================================
    --- rtl/i386/setjump.inc	(revision 26118)
    +++ rtl/i386/setjump.inc	(working copy)
    @@ -12,8 +12,27 @@
         MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
     
      **********************************************************************}
    + 
    + {$ifdef win32}
    + const
    +  _EXCEPTION_MAXIMUM_PARAMETERS=15;
     
    +type
    +  _PEXCEPTION_RECORD = ^_EXCEPTION_RECORD;
    +  _EXCEPTION_RECORD = record
    +  ExceptionCode:DWORD;
    +  ExceptionFlags:DWORD;
    +  ExceptionRecord:_PEXCEPTION_RECORD;
    +  ExceptionAddress:Pointer;
    +  NumberParameters:DWORD;
    +  ExceptionInformation:array[0.._EXCEPTION_MAXIMUM_PARAMETERS-1] of Longword;
    +  end;
    +  
    +function  thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl; forward;
    + {$endif}
    +
     Function fpc_SetJmp (Var S : Jmp_buf) : longint;assembler;nostackframe;[Public, alias : 'FPC_SETJMP']; compilerproc;
    +label Next0;
     asm
       movl %ebx,Jmp_buf.ebx(%eax)
       movl %esi,Jmp_buf.esi(%eax)
    @@ -24,7 +43,23 @@
       movl (%esp),%edi
       movl %edi,Jmp_buf.pc(%eax)
       movl Jmp_buf.edi(%eax),%edi
    +  {$ifdef win32}
    +  popl %ecx // ret addr
    +  pushl %ebp
    +  pushl $0
    +  pushl $0
    +  pushl Jmp_buf.pc(%eax)  // [eax+20]
    +  pushl thread_exception_handler
    +  pushl %fs:(0)
    +  movl %esp,%fs:(0)
    +  pushl %ecx // ret addr
    +  {$endif}
       xorl %eax,%eax
    +  jmp Next0
    +  .byte 0x88
    +  .byte 0x88
    +  .byte 0x99
    +Next0:  
     end;
     
     
    Index: rtl/inc/except.inc
    ===================================================================
    --- rtl/inc/except.inc	(revision 26118)
    +++ rtl/inc/except.inc	(working copy)
    @@ -48,6 +48,10 @@
       ExceptAddrStack   : PExceptAddr;
       ExceptObjectStack : PExceptObject;
       ExceptTryLevel    : longint;
    +  {$ifdef win32}
    +  ExceptAddrSkip    : PExceptAddr;
    +  SkipAddrCount     : Integer;
    +  {$endif}
     
     Function RaiseList : PExceptObject;
     begin
    @@ -236,6 +240,12 @@
     Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
     var
       hp : ^PExceptAddr;
    + (*  
    +{$ifdef win32}  
    +  prev,curr : PExceptAddr;
    +  cstack, TopStack : PtrUInt;
    +{$endif}  
    +  *)
     begin
     {$ifdef excdebug}
       writeln ('In Popaddrstack');
    @@ -250,7 +260,83 @@
         end
       else
         begin
    +	  (*
    +	  {$ifdef win32}
    +	  asm 
    +	    mov %ebp,cstack
    +		mov %fs:(4),%eax
    +		mov %eax,TopStack
    +	  end;
    +	  // remove skiped poping
    +	  if (ExceptAddrSkip<>nil) then
    +	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
    +	  begin
    +	    ExceptAddrSkip:=nil;
    +		while SkipAddrCount>0 do begin
    +		  hp^:=hp^^.Next;
    +		  Dec(SkipAddrCount);
    +		  if hp^=nil then
    +		    break;
    +		end;
    +	  end;
    +	  // start traverse
    +	  prev:=hp^;	  
    +	  curr:=prev;
    +	  while curr<>nil do
    +	  begin
    +	    // exceptstack in stack range
    +	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
    +		begin
    +		  if curr=prev then
    +		    hp^:=hp^^.Next
    +			else
    +			  prev^.Next:=curr^.Next;
    +		  break;
    +		end else begin
    +		  // prevent main thread's other thread poping
    +		  if PtrUInt(curr)>TopStack then
    +		  begin
    +		    if ExceptAddrSkip=nil then
    +			begin
    +		      ExceptAddrSkip:=Pointer(cstack);
    +			  SkipAddrCount:=1;
    +			end else
    +			  Inc(SkipAddrCount);
    +		    break;
    +		  end;
    +		  prev:=curr;
    +		  curr:=curr^.Next;
    +		end;
    +	  end;
    +	  {$else}
    +	  *)
           hp^:=hp^^.Next;
    +	  //{$endif}
    +// per thread SEH
    +  {$ifdef win32}
    +  asm
    +    (*
    +    ebp+20 ebp
    +    ebp+1c 0
    +    ebp+18 0
    +    ebp+14 safe
    +    ebp+10 handler
    +    ebp+c fs:[0]
    +	ebp+8 eax
    +    ebp+4 caller
    +    ebp ebp
    +	*)
    +	movl 0xc(%ebp),%eax
    +	movl %eax,%fs:(0)
    +	movl 0x8(%ebp),%eax
    +	movl %eax,0xc(%ebp)
    +	movl 0x4(%ebp),%eax
    +	movl %eax,0x8(%ebp)
    +	movl 0x0(%ebp),%eax
    +	movl %eax,0x4(%ebp)
    +	addl $0x4,%ebp
    +  end;
    +  {$endif}		  
         end;
     end;
     
    @@ -394,6 +480,9 @@
     begin
       ExceptObjectstack:=Nil;
       ExceptAddrStack:=Nil;
    +  {$ifdef win32}
    +  ExceptAddrSkip:=Nil;
    +  {$endif}
     end;
     
     
    Index: rtl/win32/system.pp
    ===================================================================
    --- rtl/win32/system.pp	(revision 26118)
    +++ rtl/win32/system.pp	(working copy)
    @@ -513,6 +513,114 @@
         end;
         syswin32_i386_exception_handler := res;
       end;
    +  
    +  // per thread SEH
    +procedure RtlUnwind(
    +    TargetFrame : PVOID;
    +    TargetIp : PVOID;
    +    ExceptionRecord : _PEXCEPTION_RECORD;
    +    ReturnValue : PVOID
    +  ); stdcall; external 'kernel32.dll' name 'RtlUnwind';  
    +  
    +function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
    +  label unwind_ret;  
    +  var
    +    res: longint;
    +    err: byte;
    +    must_reset_fpu: boolean;
    +  begin
    +    res := EXCEPTION_CONTINUE_SEARCH;
    +	exit(0);
    +      err := 0;
    +      must_reset_fpu := true;	
    +    case ExceptRecord^.ExceptionCode of	
    +        STATUS_INTEGER_DIVIDE_BY_ZERO,
    +        STATUS_FLOAT_DIVIDE_BY_ZERO :
    +          err := 200;
    +        STATUS_ARRAY_BOUNDS_EXCEEDED :
    +          begin
    +            err := 201;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_STACK_OVERFLOW :
    +          begin
    +            err := 202;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_FLOAT_OVERFLOW :
    +          err := 205;
    +        STATUS_FLOAT_DENORMAL_OPERAND,
    +        STATUS_FLOAT_UNDERFLOW :
    +          err := 206;	
    +        STATUS_FLOAT_INEXACT_RESULT,
    +        STATUS_FLOAT_INVALID_OPERATION,
    +        STATUS_FLOAT_STACK_CHECK :
    +          err := 207;
    +        STATUS_INTEGER_OVERFLOW :
    +          begin
    +            err := 215;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_ILLEGAL_INSTRUCTION:
    +          { if we're testing sse support, simply set the flag and continue }
    +          if sse_check then
    +            begin
    +              os_supports_sse:=false;
    +              { skip the offending movaps %xmm7, %xmm6 instruction }
    +              inc(PDWORD(Context+$0b8)^,3);
    +              ExceptRecord^.ExceptionCode := 0;
    +              res:=EXCEPTION_CONTINUE_EXECUTION;
    +            end
    +          else
    +            err := 216;
    +        STATUS_ACCESS_VIOLATION:
    +          { Athlon prefetch bug? }
    +          if is_prefetch(pointer(PDWORD(Context+$0b8))) then
    +            begin
    +              { if yes, then retry }
    +              ExceptRecord^.ExceptionCode := 0;
    +              res:=EXCEPTION_CONTINUE_EXECUTION;
    +            end
    +          else
    +            err := 216;	
    +        STATUS_PRIVILEGED_INSTRUCTION:
    +          begin
    +            err := 218;
    +            must_reset_fpu := false;
    +          end;
    +        else
    +          begin
    +            if ((ExceptRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
    +              err := 217
    +            else
    +              err := 255;
    +          end;	
    +	end;
    +	
    +	if err<>0 then begin
    +	    asm
    +	    pushl $0
    +		pushl ExceptRecord
    +		pushl $unwind_ret
    +		pushl Frame
    +		call RtlUnwind
    +		.byte 0x77
    +		.byte 0x88
    +		.byte 0x99
    +		end;
    +unwind_ret:
    +      PDWORD(Context+$0c4)^:=PtrUInt(Frame);     // esp
    +      PDWORD(Context+$0b8)^:=PDWORD(Frame+8)^;   // eip ?
    +      PDWORD(context+$0b4)^:=PDWORD(Frame+$14)^; // ebp	
    +      //PDWORD(context+$0b0)^:=1;                // eax		
    +    if (exceptLevel > 0) then
    +      dec(exceptLevel);	  
    +    if resetFPU[exceptLevel] then
    +      SysResetFPU;	  
    +	end;
    +	  
    +    thread_exception_handler := res;
    +  end;
     
     procedure install_exception_handlers;
     {$ifdef SYSTEMEXCEPTIONDEBUG}
    
  • fpc_win32_per_thread_revised.patch (7,702 bytes)
    Index: rtl/i386/setjump.inc
    ===================================================================
    --- rtl/i386/setjump.inc	(revision 26118)
    +++ rtl/i386/setjump.inc	(working copy)
    @@ -12,8 +12,27 @@
         MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
     
      **********************************************************************}
    + 
    +  {$ifdef win32}
    + const
    +  _EXCEPTION_MAXIMUM_PARAMETERS=15;
     
    +type
    +  _PEXCEPTION_RECORD = ^_EXCEPTION_RECORD;
    +  _EXCEPTION_RECORD = record
    +  ExceptionCode:DWORD;
    +  ExceptionFlags:DWORD;
    +  ExceptionRecord:_PEXCEPTION_RECORD;
    +  ExceptionAddress:Pointer;
    +  NumberParameters:DWORD;
    +  ExceptionInformation:array[0.._EXCEPTION_MAXIMUM_PARAMETERS-1] of Longword;
    +  end;
    +  
    +function  thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl; forward;
    + {$endif}
    +
     Function fpc_SetJmp (Var S : Jmp_buf) : longint;assembler;nostackframe;[Public, alias : 'FPC_SETJMP']; compilerproc;
    +label Next0;
     asm
       movl %ebx,Jmp_buf.ebx(%eax)
       movl %esi,Jmp_buf.esi(%eax)
    @@ -24,7 +43,24 @@
       movl (%esp),%edi
       movl %edi,Jmp_buf.pc(%eax)
       movl Jmp_buf.edi(%eax),%edi
    +  {$ifdef win32}
    +  popl %edx // ret addr
    +  pushl Jmp_buf.bp(%eax)
    +  pushl $0
    +  pushl $0
    +  pushl Jmp_buf.pc(%eax)  // [eax+20]
    +  pushl $thread_exception_handler
    +  pushl %fs:(0)
    +  movl %esp,%fs:(0)
    +  pushl %edx // ret addr
    +  {$endif}
       xorl %eax,%eax
    +  jmp Next0
    +  .byte 0x88 // debug
    +  .byte 0x88
    +  .byte 0x99
    +  .byte 0x99
    +Next0:  
     end;
     
     
    Index: rtl/inc/except.inc
    ===================================================================
    --- rtl/inc/except.inc	(revision 26118)
    +++ rtl/inc/except.inc	(working copy)
    @@ -48,6 +48,10 @@
       ExceptAddrStack   : PExceptAddr;
       ExceptObjectStack : PExceptObject;
       ExceptTryLevel    : longint;
    +  {$ifdef win32}
    +  ExceptAddrSkip    : PExceptAddr;
    +  SkipAddrCount     : Integer;
    +  {$endif}
     
     Function RaiseList : PExceptObject;
     begin
    @@ -236,6 +240,12 @@
     Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
     var
       hp : ^PExceptAddr;
    +(*  
    +{$ifdef win32}  
    +  prev,curr : PExceptAddr;
    +  cstack, TopStack : PtrUInt;
    +{$endif}  
    +*)
     begin
     {$ifdef excdebug}
       writeln ('In Popaddrstack');
    @@ -250,8 +260,85 @@
         end
       else
         begin
    +	(*
    +	  {$ifdef win32}
    +	  asm 
    +	    mov %ebp,cstack
    +		mov %fs:(4),%eax
    +		mov %eax,TopStack
    +	  end;
    +	  // remove skiped poping
    +	  if (ExceptAddrSkip<>nil) then
    +	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
    +	  begin
    +	    ExceptAddrSkip:=nil;
    +		while SkipAddrCount>0 do begin
    +		  hp^:=hp^^.Next;
    +		  Dec(SkipAddrCount);
    +		  if hp^=nil then
    +		    break;
    +		end;
    +	  end;
    +	  // start traverse
    +	  prev:=hp^;	  
    +	  curr:=prev;
    +	  while curr<>nil do
    +	  begin
    +	    // exceptstack in stack range
    +	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
    +		begin
    +		  if curr=prev then
    +		    hp^:=hp^^.Next
    +			else
    +			  prev^.Next:=curr^.Next;
    +		  break;
    +		end else begin
    +		  // prevent main thread's other thread poping
    +		  if PtrUInt(curr)>TopStack then
    +		  begin
    +		    if ExceptAddrSkip=nil then
    +			begin
    +		      ExceptAddrSkip:=Pointer(cstack);
    +			  SkipAddrCount:=1;
    +			end else
    +			  Inc(SkipAddrCount);
    +		    break;
    +		  end;
    +		  prev:=curr;
    +		  curr:=curr^.Next;
    +		end;
    +	  end;
    +	  {$else}
    +	  *)
           hp^:=hp^^.Next;
    +	  //{$endif}
         end;
    +// per thread SEH
    +  {$ifdef win32}
    +  asm
    +    {
    +    ebp+20 ebp
    +    ebp+1c 0
    +    ebp+18 0
    +    ebp+14 safe
    +    ebp+10 handler
    +    ebp+c fs:[0]
    +	ebp+8 eax
    +    ebp+4 caller
    +    ebp ebp
    +	}
    +	movl (%ebp),%eax
    +	movl %eax,0x18(%ebp)
    +	movl 0x04(%ebp),%eax
    +	movl %eax,0x1c(%ebp)
    +	movl 0x08(%ebp),%eax
    +	movl %eax,0x20(%ebp)
    +	movl 0x0c(%ebp),%eax
    +	movl %eax,%fs:(0)
    +	addl $0x18,%ebp
    +  end;
    +  {$endif}		  
    +
     end;
     
     
    @@ -394,6 +481,9 @@
     begin
       ExceptObjectstack:=Nil;
       ExceptAddrStack:=Nil;
    +  {$ifdef win32}
    +  ExceptAddrSkip:=Nil;
    +  {$endif}
     end;
     
     
    Index: rtl/win32/system.pp
    ===================================================================
    --- rtl/win32/system.pp	(revision 26118)
    +++ rtl/win32/system.pp	(working copy)
    @@ -513,6 +513,122 @@
         end;
         syswin32_i386_exception_handler := res;
       end;
    +  
    +  // per thread SEH
    +procedure RtlUnwind(
    +    TargetFrame : PVOID;
    +    TargetIp : PVOID;
    +    ExceptionRecord : _PEXCEPTION_RECORD;
    +    ReturnValue : PVOID
    +  ); stdcall; external 'kernel32.dll' name 'RtlUnwind';  
    +  
    +function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
    +  label unwind_ret;  
    +  var
    +    res: longint;
    +    err: byte;
    +    must_reset_fpu: boolean;
    +  begin
    +    res := EXCEPTION_CONTINUE_SEARCH;
    +      err := 0;
    +      must_reset_fpu := true;	
    +    case ExceptRecord^.ExceptionCode of	
    +        STATUS_INTEGER_DIVIDE_BY_ZERO,
    +        STATUS_FLOAT_DIVIDE_BY_ZERO :
    +          err := 200;
    +        STATUS_ARRAY_BOUNDS_EXCEEDED :
    +          begin
    +            err := 201;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_STACK_OVERFLOW :
    +          begin
    +            err := 202;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_FLOAT_OVERFLOW :
    +          err := 205;
    +        STATUS_FLOAT_DENORMAL_OPERAND,
    +        STATUS_FLOAT_UNDERFLOW :
    +          err := 206;	
    +        STATUS_FLOAT_INEXACT_RESULT,
    +        STATUS_FLOAT_INVALID_OPERATION,
    +        STATUS_FLOAT_STACK_CHECK :
    +          err := 207;
    +        STATUS_INTEGER_OVERFLOW :
    +          begin
    +            err := 215;
    +            must_reset_fpu := false;
    +          end;
    +        STATUS_ILLEGAL_INSTRUCTION:
    +          { if we're testing sse support, simply set the flag and continue }
    +          if sse_check then
    +            begin
    +              os_supports_sse:=false;
    +              { skip the offending movaps %xmm7, %xmm6 instruction }
    +              inc(PDWORD(Context+$0b8)^,3);
    +              ExceptRecord^.ExceptionCode := 0;
    +              res:=EXCEPTION_CONTINUE_EXECUTION;
    +            end
    +          else
    +            err := 216;
    +        STATUS_ACCESS_VIOLATION:
    +          { Athlon prefetch bug? }
    +          if is_prefetch(pointer(PDWORD(Context+$0b8))) then
    +            begin
    +              { if yes, then retry }
    +              ExceptRecord^.ExceptionCode := 0;
    +              res:=EXCEPTION_CONTINUE_EXECUTION;
    +            end
    +          else
    +            err := 216;	
    +        STATUS_PRIVILEGED_INSTRUCTION:
    +          begin
    +            err := 218;
    +            must_reset_fpu := false;
    +          end;
    +        else
    +          begin
    +            if ((ExceptRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
    +              err := 217
    +            else
    +              err := 255;
    +          end;	
    +	end;
    +	
    +	if res=EXCEPTION_CONTINUE_EXECUTION then begin
    +	    asm
    +		pushl %ebx
    +		pushl %edi
    +		pushl %esi
    +	    pushl $0
    +		pushl ExceptRecord
    +		pushl $unwind_ret
    +		pushl Frame
    +		call RtlUnwind
    +		jmp unwind_ret
    +		.byte 0x77 // debug
    +		.byte 0x77
    +		.byte 0x99
    +		.byte 0x99
    +unwind_ret:		
    +        popl %esi
    +		popl %edi
    +		popl %ebx
    +		end;
    +      PDWORD(Context+$0c4)^:=PtrUInt(Frame);     // esp
    +      PDWORD(Context+$0b8)^:=PDWORD(Frame+8)^;   // eip ?
    +      PDWORD(context+$0b4)^:=PDWORD(Frame+$14)^; // ebp	
    +      //PDWORD(context+$0b0)^:=1;                // eax		
    +    if (exceptLevel > 0) then
    +      dec(exceptLevel);	  
    +    if resetFPU[exceptLevel] then
    +      SysResetFPU;	  
    +	  
    +	  thread_exception_handler := 0;	  
    +	end else
    +	  thread_exception_handler := 1;
    +  end;
     
     procedure install_exception_handlers;
     {$ifdef SYSTEMEXCEPTIONDEBUG}
    
  • fiberdemo.dpr (1,838 bytes)
  • updated_fiberdemo.zip (1,809 bytes)

Relationships

related to 0012974 new FPC can't catch windows exceptions (av's) in a try/except in a dll call 
related to 0025363 closedSergei Gorelkin win32 per thread SEH implemantaion. 

Activities

Andrey Paramonov

2013-11-12 13:18

reporter  

fiberdemo.lpr (1,587 bytes)

Max Nazhalov

2013-11-12 16:36

reporter   ~0071280

My guess: such exception can be caught only with native SEH, which is not [and probably never will be] implemented for the Win32-i386.

See, e.g. [Windows via C/C++, Fifth Edition; Jeffrey Richter]:

QUOTE begin/:
The first step you must perform when you use fibers is to turn your existing thread into a fiber. You do this by calling ConvertThreadToFiber:

PVOID ConvertThreadToFiber(PVOID pvParam);

This function allocates memory (about 200 bytes) for the fiber's execution context. This execution context consists of the following elements:

..skip...

The head of a structured exception-handling chain

..skip...

/QUOTE end

Do-wan Kim

2013-11-13 08:58

reporter   ~0071297

example also fail on 2.7.1.

below link maybe help to solve problem.
I don't know what it talk about XD

http://stackoverflow.com/questions/9249576/seh-setup-for-fibers-with-exception-chain-validation-sehop-active

Andrey Paramonov

2013-11-13 13:11

reporter   ~0071298

Last edited: 2013-11-13 13:22

View 3 revisions

Hello Max!

As you can see, I do actually call ConvertThreadToFiber(nil) in the constructor.

Delphi stores exception handler chain in the TEB (also known as TIB):

type
  TThreadEnvironmentBlock = packed record
    ExceptionList: PExceptionRegistrationRecord;
    StackBase: Longword;
    StackLimit: Longword;
    SubSystemTib: Longword;
    Union: record
    case Integer of
      0: (FiberData: Longword);
      1: (Version: Longword);
    end;
    ArbitraryUserPointer: Longword;
    Self: Longword;
  end;

The following function returns TEB of the current thread/fiber, allowing me to save and restore exception chain of the fiber would I implement fibers myself.

function GetCurrentTEB: PThreadEnvironmentBlock;
asm
  mov eax, fs:[$18]
end;

Windows API does save/restore ExceptionList when switching fibers.

I've tried to read the source code of FreePascal, but I'm not sure where exception handler chain is stored. It seems that it has to be stored in ExceptionList to support "hardware"-to-"software" exception translation (EZeroDivide?). However from reading FreePascal sources I see that some exception-related objects are stored in threadvars. I'm not sure where these are stored physically.

---

Hello Kim!

I think I do understand what SEHOP is about.

Basically Server-flavour Windows requires that:
1) All exception handlers are allocated inside StackLimit..StackBase range.
2) Final exception handler is ntdll.dll!FinalExceptionHandler.

It is believed to prevent the corruption of exception chain for the sake of hijacking the execution flow. Some sort of anti-virus/anti-crack protection.

CreateProcess, CreateThread and CreateFiber do needed magick to fulfil 1) and 2) automatically. Even if you would implement fibers manually, it's not really hard to fulfil above conditions.

Best wishes,
Andrey Paramonov

Max Nazhalov

2013-11-13 13:24

reporter   ~0071299

FreePascal does not use Windows SEH on Win32 at all. It implements its own (platform-independent) mechanics to handle exceptions, which does not care of fibers, I suppose. For Win32 this mechanism is relied upon RtlUnhandledExceptionFilter API, exception chain is exclusively maintained by FPC RTL, and is completely different form Win32-native one.

Andrey Paramonov

2013-11-13 13:53

reporter   ~0071300

Hmm, I see, thank you.
From sources I see that exception-related objects are stored in threadvars. Now I'm curious where FreePascal threadvars are physically stored for w32? It should be somewhere in the TEB I presume.

Max Nazhalov

2013-11-13 14:26

reporter   ~0071301

Last edited: 2013-11-13 14:27

View 2 revisions

I'm not sure, but it seems that the memory for holding threadvars is allocated from the default Windows heap using LocalAlloc, and accessed via TLS API.
Look into \fpc\rtl\win\systhrd.inc.

Do-wan Kim

2013-11-13 22:59

reporter   ~0071304

Last edited: 2013-11-14 06:03

View 4 revisions

Thank you for explaination for it, Andrey :)

edit:
Ah, mistake. it didn't work xD

I guess it may do something on "Threadmain" call.
win64 SEH do something with it at 2.7.1.

    function ThreadMain(param : pointer) : Longint; {$ifdef wince}cdecl{$else}stdcall{$endif};
      var
        ti : tthreadinfo;
      begin
        { Copy parameter to local data }
        ti:=pthreadinfo(param)^;

        { Handle all possible threadvar models:
          - dynamic threadvars: initialized either in DllMain,
            or upon accessing the threadvar ThreadID;
          - static threadvars+TLS callback: initialized in TLS callback;
          - static threadvars, no callback: ThreadID remains 0 and
            initialization happens here. }
        if ThreadID=TThreadID(0) then
          InitThread(ti.stklen);

        dispose(pthreadinfo(param));

        { Start thread function }
{$ifdef DEBUG_MT}
        writeln('Jumping to thread function of thread ',Win32GetCurrentThreadId);
{$endif DEBUG_MT}
{$ifdef FPC_USE_WIN64_SEH}
        { use special 'top-level' exception handler around the thread function }
        ThreadMain:=main_wrapper(ti.p,pointer(ti.f));
{$else FPC_USE_WIN64_SEH}
        ThreadMain:=ti.f(ti.p); // <- win32
{$endif FPC_USE_WIN64_SEH}
      end;

Andrey Paramonov

2013-11-14 07:18

reporter   ~0071305

I've done some further investigation and it turns out that the problem is also reproducible for w64. To reproduce for w64 GetCurrentFiber should be changed to:

function GetCurrentFiber: Pointer;
asm
  mov rax, gs:[$20]
end;

Max noted that FreePascal does not use Windows SEH on w32 at all. And what about w64? Maybe some additional code can be written on program side to initialize exception handling in a fiber?

Do-wan Kim

2013-11-14 08:59

reporter   ~0071308

It works perfectly at fpc 2.7.1 r26083 win64 SEH.

Sven Barth

2013-11-14 09:18

manager   ~0071309

On Win32 Free Pascal uses SetUnhandledExceptionFilter to set up "catch all" handler which will then invoke FPC's platform independant exception handling system (see syswin32_i386_exception_handler in %fpcdir%\rtl\win32\system.pp).

Maybe the problem could be solved by setting up at least one exception frame with the catch all exception handler as filter which wraps the threads main procedure.

Note: I wouldn't rule out the possiblity completely that FPC will someone in the future support SEH for i386 and ARM as well. Afterall x86_64 got it already... (though i386 is very different from the x86_64 and ARM one)

Regards,
Sven

Do-wan Kim

2013-11-15 01:58

reporter   ~0071320

Last edited: 2013-11-15 06:44

View 3 revisions

Maybe there is another solution that prevent overwrite Exception handler by other thread.

edit:
Improve version of it, it's not working;

function PreventSetUnhandledExceptionFilter:Boolean;
const
  szExecute:array[0..4] of byte=($33, $C0, $C2, $04, $00);
var
  hKernel32:THANDLE;
  pOrgEntry:Pointer;
  bytesWritten:SizeInt;
begin
  hKernel32:=LoadLibrary('kernel32.dll');
  if hKernel32=0 then
   exit(False);
  pOrgEntry:=Pointer(GetProcAddress(hKernel32,'SetUnhandledExceptionFilter'));
  if pOrgEntry=nil then
   exit(False);
  bytesWritten:=0;
  Result:=WriteProcessMemory(GetCurrentProcess(),
      pOrgEntry, @szExecute[0], sizeof(szExecute), @bytesWritten);
end;

Sven Barth

2013-11-15 07:51

manager   ~0071321

What the?! No, just no. This will prevent ANY exceptions from happening in the application. I definitely don't consider this a solution and advice anyone not to consider it as one as well.

Regards,
Sven

Do-wan Kim

2013-11-15 11:07

reporter   ~0071324

It's just test purpose xD

There is sample code getting TIB.
http://recxltd.blogspot.de/2012/02/from-archives-printing-seh-chain-from.html

It maybe help you, Andrey.

function PrintSEH(hProc, hThread: THANDLE):Integer;
var
  contex:jwawinnt.CONTEXT;
  ldtsel:JwaWinNT.LDT_ENTRY;
  dwFSBase, dwNext, dwHandler, dwCount:DWORD;
begin
 // Get the full context of the processor
 contex.ContextFlags := CONTEXT_FULL;
 if not GetThreadContext( hThread, contex ) then begin
  writeln('[!] GetThreadContext failed!');
  exit(1);
 end;

 // this bit of leetness came from the code breakers journal
 // http://powerhacker.net/documents/Reverse_Engineering/codebreakers_journal/CBJ-2005-65.pdf
 if not GetThreadSelectorEntry(hThread, contex.SegFs, ldtSel) then begin
  writeln('[!] GetThreadSelectorEntry failed!');
  exit(1);
 end;

 // http://archives.neohapsis.com/archives/fulldisclosure/2004-10/att-0339/sessmgr.c
 dwFSBase := (ldtSel.BaseHi shl 24 ) or ( ldtSel.BaseMid shl 16 ) or ( ldtSel.BaseLow );
 writeln(Format('[i] FS:[0] (TIB) is @ 0x%08X',[dwFSBase]));

 dwNext:=0;
 dwHandler:=0;
 dwCount:=0;

 // Now walk the structure
 dwNext:=dwFSBase;
 while dwNext<>$FFFFFFFF do begin
  // Read the Current
  if not ReadProcessMemory(hProc,Pointer(dwNext+4),@dwHandler,sizeof(DWORD),nil) then begin
   writeln('[!] ReadProcessMemory failed!');
   exit(1);
  end;

  // Read the Next
  if not ReadProcessMemory(hProc,Pointer(dwNext),@dwNext,sizeof(DWORD), nil) then begin
   writeln('[!] ReadProcessMemory failed!');
   exit(1);
  end;

  if dwCount>0 then
   writeln(format('[i] Exception Handler [%d] is handled by 0x%08X 0x%08X',[dwCount,dwHandler,dwNext]));

  Inc(dwCount);
 end;

 if dwCount=0 then
  writeln('[i] Not SEH Chain Entries Found! - This could be because it''s not populated yet! ');

 Result:=0;
end;

Sergei Gorelkin

2013-11-16 00:28

developer   ~0071329

In win32 version of this program there is no SEH-related activity, everything happens entirely using RTL routines. Replacing 'raise' statement with code that raises an actual OS exception (e.g. division by zero), however, does not change anything.
Currently I fail to understand why the exception bypasses one handler but is caught by another immediately following one, located within the same function and entered within same thread/fiber context (there is no switching of fibers between try statements).

Do-wan Kim

2013-11-16 05:07

reporter   ~0071330

Last edited: 2013-11-17 10:56

View 8 revisions

How about this method for exception handling?

call fpc_pushexceptaddr(..,_buf,..)
call fpc_setjmp(..)
push _buf
...
pop _buf
call fpc_PopAddrStack(_buf);

new fpc_popAddrstack procedure in except.inc

Procedure fpc_PopAddrStack(_buf:Pointer);[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
var
  hp : ^PExceptAddr;
  prev, curr: PExceptAddr;
begin
{$ifdef excdebug}
  writeln ('In Popaddrstack');
{$endif}
  hp:=@ExceptAddrStack;
  If hp^=nil then
    begin
{$ifdef excdebug}
      writeln ('At end of ExceptionAddresStack');
{$endif}
      halt (255);
    end
  else
  begin
    // initialize traverse
    prev:=hp^;
    curr:=hp^;
    while curr<>nil do
    begin
      // match jmp buf
      if curr.buf=_buf then
      begin
        // if ExceptStackTop, just assign ExceptAddr
        if curr=prev then
          hp^:=curr.Next
          else
            // else delete from linked list
            prev.Next:=curr.Next
        break;
      end else
      // get next ExceptAddr
      begin
        prev:=curr;
        curr:=curr.Next;
      end;
    end;
  end;
end;

how to change
'procedure new_exception' to 'push _buf' after 'fpc_setjmp' and
'procedure free_exception' to 'pop _buf' before calling
in ncgutil.pas?

Do-wan Kim

2013-11-16 10:44

reporter  

fiberdemo_int.zip (1,803 bytes)

Do-wan Kim

2013-11-17 01:17

reporter  

Sergei Gorelkin

2013-11-17 11:46

developer   ~0071351

Well, reading the documentation reveals that fibers have their own local storage, which has to be used by RTL to store thread vars (which include exception stacks) in order to make things working.

It also means that Win64 version of the example works only by coincidence and will fail at more complex case.

Andrey Paramonov

2013-11-19 15:34

reporter   ~0071400

Finally I managed to compile my example on w32 x86-64 using latest 2.7.1 fpc... God, why compilation is such a torture on Windows?? :-/

Anyway, I confirm that fiber API works fine on w32 x86-64 when compiled using latest 2.7.1 fpc. I don't think it's a coincidence as I used more complex examples (see attachment; should be compiled with -MDelphi).

Going to check ucontext POSIX API today.

I believe that fiber iterators provide *very* useful pattern. Probably every wide-used contemporary language has built-in iterator support (e.g. C# yield, Python generators). It seems that FreePascal should also be able to support fiber iterators, at least via side unit and on most important architectures.

Native SEH seems a pre-requisite for fiber support on w32.
Should I submit a separate wishlist item for that?

Andrey Paramonov

2013-11-19 15:35

reporter  

iterimpl.pas (4,716 bytes)
unit iterimpl;

// Delphi debugger always stops on exception handler code when using
// F8 (Step Over). It is especially annoying for iterators because
// in case of EStopIteration one cannot easily walk up the stack and
// resume execution.
// Fix it by disabling debug info for this unit.
{$D-}

interface

uses
  sysutils;

const
  cDefStackSize = 64*1024;

type
  TFiberIterator = class
  private
    FWorkerContext: Pointer;
    FCallerContext: Pointer;

    FIsIterating: Boolean;  // is inside Iterate
    FNeedStop: Boolean;     // will forcibly finish Iterate by throwing EStopIteration
    FNeedReset: Boolean;    // will restart Iterate
    FFatalException: TObject;
    FValue: Pointer;

    procedure IterateProc; stdcall;
    function AcquireFatalException: TObject;

  protected
    procedure DoIterate; virtual;
    procedure Iterate; virtual; abstract;
    procedure SwitchToWorker;
    procedure SwitchToCaller;

  public
    constructor Create(AStackSize: Integer =cDefStackSize);
    destructor Destroy; override;
    procedure Yield(AValue: Pointer);
    function GetNext(out AValue: Pointer): Boolean; virtual;
    procedure Reset; virtual;
  end;

  // *optional* way to stop iterator early
  // do not catch
  EStopIteration = class(Exception)
  public
    constructor Create;
  end;

implementation

{$IFDEF FPC}
{$ASMMODE intel}
{$ENDIF}

uses
  windows, jwawinbase;

function GetCurrentFiber: PVOID;
asm
  mov eax, gs:[$20]
end;

function SetThreadStackGuarantee(var StackSizeInBytes: PULONG): LONGBOOL;
  external 'kernel32.dll' name 'SetThreadStackGuarantee';

function CreateEmptyContext: Pointer;
begin
  ConvertThreadToFiber(nil);
  Result := GetCurrentFiber;
end;

function CreateContext(AStackSize: Cardinal;
  AEntryProc, AEntryProcParam: Pointer): Pointer;
begin
  Result := CreateFiber(AStackSize, AEntryProc, AEntryProcParam);
end;

procedure FreeContext(var AContext: Pointer);
begin
  DeleteFiber(AContext);
  AContext := nil;
end;

procedure SwitchContext(ASwitchFrom, ASwitchTo: Pointer);
begin
  SwitchToFiber(ASwitchTo);
end;

procedure InstallStackProtection(AContext: Pointer);
var
  Size: Cardinal;
  PSize: PCardinal;
begin
  Size := 4096;
  PSize := @Size;
  SetThreadStackGuarantee(PSize);
end;

{ TFiberIterator }
constructor TFiberIterator.Create(AStackSize: Integer);
begin
  inherited Create;
  FCallerContext := CreateEmptyContext;
  FWorkerContext := CreateContext(AStackSize, @TFiberIterator.IterateProc, Self);
end;

destructor TFiberIterator.Destroy;
begin
  if FIsIterating then
  begin
    FNeedStop := True;
    SwitchToWorker;
  end;
  FreeContext(FWorkerContext);
  //FreeContext(FCallerContext);
  FFatalException.Free;
  inherited;
end;

procedure TFiberIterator.Reset;
begin
  if FIsIterating then
    FNeedStop := True;
  FNeedReset := True;
end;

function TFiberIterator.AcquireFatalException: TObject;
begin
  Result := FFatalException;
  FFatalException := nil;
end;

procedure TFiberIterator.DoIterate;
begin
  Iterate;
end;

procedure TFiberIterator.IterateProc; stdcall;
begin
  try
    while True do
    begin
      FNeedReset := False;
      InstallStackProtection(PContext(FWorkerContext));

      // iterate
      FIsIterating := True;
      try
        try
          DoIterate;
        except
          on EStopIteration do;
            // pass
          on E: Exception do
            FFatalException := AcquireExceptionObject;
        end;
      finally
        FIsIterating := False;
        FNeedStop := False;
      end;

      // keep context alive
      while True do
        if FNeedReset then
          Break
        else
          Yield(nil);
    end;
  except
    // should never get here
    on E: Exception do
      ShowException(E, ExceptAddr);
  end;
end;

procedure TFiberIterator.Yield(AValue: Pointer);
// executed in worker context
begin
  FValue := AValue;
  SwitchToCaller;
  if FIsIterating and FNeedStop then
    raise EStopIteration.Create;
end;

function TFiberIterator.GetNext(out AValue: Pointer): Boolean;
// executed in caller context
begin
  SwitchToWorker;
  if FFatalException <> nil then
    raise AcquireFatalException;
  Result := FIsIterating;
  AValue := FValue;
end;

procedure TFiberIterator.SwitchToCaller;
begin
  SwitchContext(FWorkerContext, FCallerContext);
end;

procedure TFiberIterator.SwitchToWorker;
begin
  SwitchContext(FCallerContext, FWorkerContext);
end;

{ EStopIteration }
constructor EStopIteration.Create;
begin
  inherited Create('Stop iteration');
end;

end.

iterimpl.pas (4,716 bytes)

Andrey Paramonov

2013-11-19 15:36

reporter  

baseiter.pas (4,428 bytes)
unit baseiter;

interface

uses
  iterimpl;

type
  // Base iterator interfaces
  IIterator<T> = interface
    function Next(out AValue: T): Boolean;
  end;

  IGenericIterator = IIterator<Pointer>;
  IStringIterator = IIterator<String>;
  IIntegerIterator = IIterator<Integer>;
  IFloatIterator = IIterator<Double>;

  IResettable = interface
  ['{3CC2EE46-A542-4954-BCC0-523C68B60089}']
    procedure Reset;
  end;

// --------

  // Base iterator classes
  TIterator<T> = class(TInterfacedObject, IIterator<T>)
  private
    FCurrent: T;
    function NopGetCurrent: TObject;
  public
    function Next(out AValue: T): Boolean; virtual; abstract;
    procedure Reset; virtual;
    // IEnumerator
    function MoveNext: Boolean;
    function GetCurrent: T;
    property Current: T read GetCurrent;
    // for-in support
    function GetEnumerator: TIterator<T>;
    function Copy: TIterator<T>;
  end;

  TGenericIterator = TIterator<Pointer>;
  TStringIterator = TIterator<String>;
  TIntegerIterator = TIterator<Integer>;
  TFloatIterator = TIterator<Double>;

// --------

  // Base fiber iterator classes
  TBaseIterator<T> = class(TIterator<T>, IResettable)
  private
    FIter: TFiberIterator;
  protected
    procedure Yield(const AValue: T);
    procedure Iterate; virtual; //abstract;
  public
    constructor Create(AStackSize: Integer =cDefStackSize);
    destructor Destroy; override;
    function Next(out AValue: T): Boolean; override; final;
    procedure Reset; override; final;
  end;

  TBaseGenericIterator = TBaseIterator<Pointer>;
  TBaseStringIterator = TBaseIterator<String>;
  TBaseIntegerIterator = TBaseIterator<Integer>;
  TBaseFloatIterator = TBaseIterator<Double>;

  // *optional* way to stop iterator early
  // do not catch
  EStopIteration = iterimpl.EStopIteration;

// --------

type
  TExtIterator<T> = class(TIterator<T>)
  private
    FIter: TIterator<T>;
  public
    constructor Create(AIter: TIterator<T>);
    function Next(out AValue: T): Boolean; override;
    procedure Reset; override;
  end;

  TIterateMethod = procedure of object;

function CreateFiberIterator(ADoIterate: TIterateMethod;
  AStackSize: Integer): TFiberIterator;

implementation

type
  TMethodIterator = class(TFiberIterator)
  private
    FDoIterate: TIterateMethod;
  protected
    procedure Iterate; override;
  public
    constructor Create(ADoIterate: TIterateMethod;
      AStackSize: Integer);
  end;

{ TExtIterator<T> }
constructor TExtIterator<T>.Create(AIter: TIterator<T>);
begin
  inherited Create;
  FIter := AIter;
end;

function TExtIterator<T>.Next(out AValue: T): Boolean;
begin
  Result := FIter.Next(AValue);
end;

procedure TExtIterator<T>.Reset;
begin
  FIter.Reset;
end;

{ TIterator<T> }
function TIterator<T>.MoveNext: Boolean;
begin
  Result := Next(FCurrent);
end;

function TIterator<T>.NopGetCurrent: TObject;
begin
  Result := nil;
end;

function TIterator<T>.GetCurrent: T;
begin
  Result := FCurrent;
end;

procedure TIterator<T>.Reset;
begin
  // do nothing
end;

function TIterator<T>.GetEnumerator: TIterator<T>;
begin
  Result := Self;
end;

function TIterator<T>.Copy: TIterator<T>;
begin
  Result := TExtIterator<T>.Create(Self);
end;

function CreateFiberIterator(ADoIterate: TIterateMethod;
  AStackSize: Integer): TFiberIterator;
begin
  Result := TMethodIterator.Create(ADoIterate, AStackSize);
end;

{ TMethodIterator }
constructor TMethodIterator.Create(ADoIterate: TIterateMethod;
  AStackSize: Integer);
begin
  inherited Create(AStackSize);
  FDoIterate := ADoIterate;
end;

procedure TMethodIterator.Iterate;
begin
  FDoIterate;
end;

{ TBaseIterator<T> }
constructor TBaseIterator<T>.Create(AStackSize: Integer);
begin
  inherited Create;
  FIter := CreateFiberIterator(Iterate, AStackSize);
end;

destructor TBaseIterator<T>.Destroy;
begin
  FIter.Free;
  inherited;
end;

procedure TBaseIterator<T>.Yield(const AValue: T);
begin
  FIter.Yield(Addr(AValue));
end;

procedure TBaseIterator<T>.Iterate;
begin

end;

function TBaseIterator<T>.Next(out AValue: T): Boolean;
var
  Value: Pointer;
begin
  Result := FIter.GetNext(Value);
  if Value <> nil then
    AValue := T(Value^);
end;

procedure TBaseIterator<T>.Reset;
begin
  FIter.Reset;
end;

end.

baseiter.pas (4,428 bytes)

Andrey Paramonov

2013-11-19 15:36

reporter  

iterdemo.lpr (1,284 bytes)

Sven Barth

2013-11-19 21:36

manager   ~0071401

There is already 0012974 for that.

Regards,
Sven

Do-wan Kim

2013-11-20 02:28

reporter   ~0071406

Last edited: 2013-11-20 12:30

View 6 revisions

I make triky code for win32. xD
it works for example.

Adding to fpc_popaddrstack parameter is not easy for me T.T


iterdemo works on win32. New patch is also uploaded.

Do-wan Kim

2013-11-20 05:33

reporter  

except.inc_win32.patch (954 bytes)
Index: except.inc
===================================================================
--- except.inc	(revision 26110)
+++ except.inc	(working copy)
@@ -236,6 +236,10 @@
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
 var
   hp : ^PExceptAddr;
+{$ifdef win32}  
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+{$endif}  
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,7 +254,31 @@
     end
   else
     begin
+	  {$ifdef win32}
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  prev:=hp^;
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;
+	  {$else}
       hp^:=hp^^.Next;
+	  {$endif}
     end;
 end;
 

Do-wan Kim

2013-11-20 11:26

reporter  

except.inc_win32_new.patch (2,014 bytes)
Index: except.inc
===================================================================
--- except.inc	(revision 26112)
+++ except.inc	(working copy)
@@ -48,6 +48,10 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -236,6 +240,10 @@
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
 var
   hp : ^PExceptAddr;
+{$ifdef win32}  
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+{$endif}  
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,7 +258,56 @@
     end
   else
     begin
+	  {$ifdef win32}
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  // remove skiped poping
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  // start traverse
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    // exceptstack in stack range
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  // prevent main thread's other thread poping
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=Pointer(cstack);
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;
+	  {$else}
       hp^:=hp^^.Next;
+	  {$endif}
     end;
 end;
 
@@ -394,6 +451,9 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  ExceptAddrSkip:=Nil;
+  {$endif}
 end;
 
 

Do-wan Kim

2013-11-20 12:27

reporter  

iterdemo_w32_work.zip (45,795 bytes)

Andrey Paramonov

2013-11-20 13:13

reporter   ~0071417

Thank you Kim for your comments!
Do I understand correctly that you have an more-or-less working implementation of/patch for native w32 SEH for FreePascal compiler?

Do-wan Kim

2013-11-20 14:23

reporter   ~0071419

Andrey, it's not a w32 SEH patch. It prevent only fpc_popaddrstack removes other thread exception frame in list. with this, your first source code works ok.

Main problem is exception frame linked list has removed only first top every function call. Patch was getting current stack pointer at function call, check valid to remove, and remove it from top or middle of list. That's all xD

Andrey Paramonov

2013-11-20 19:22

reporter   ~0071440

Hmm, but it's still a compiler patch.
Given that compiler should be modified anyway in order for fibers to work, maybe it's better to implement native SEH? ;-)

Do-wan Kim

2013-11-20 23:58

reporter   ~0071449

Last edited: 2013-11-21 05:08

View 3 revisions

The Best way is native SEH. Native SEH also solve DLL exception problem ;-)

This link more easy to understand win32 SEH ;)
http://www.woodmann.com/crackz/Tutorials/Seh.htm

with above article, maybe currently fpc win32 has only finalization seh method.
there is no code look like,

MYFUNCTION:
PUSH EBP ;save ebp (used to address stack frame)
MOV EBP,ESP ;use EBP as stack frame pointer
SUB ESP,40h ;make 16 dwords on stack for local data
;**** local data now addressable as [EBP-4] to [EBP-40h]
;**************** install handler and its ERR structure
PUSH EBP ;ERR+14h save ebp (being ebp at safe-place)
PUSH 0 ;ERR+10h area for flags
PUSH 0 ;ERR+0Ch information for handler
PUSH OFFSET SAFE_PLACE ;ERR+8h new eip at safe-place
PUSH OFFSET HANDLER ;ERR+4h address of handler
PUSH FS:[0] ;ERR+0h keep next ERR up the chain
MOV FS:[0],ESP ;point to ERR just made on the stack
..
.. ;code which is protected goes here
..
JMP >L10 ;normal end if there is no exception
SAFE_PLACE: ;handler sets eip/esp/ebp for here
L10:
POP FS:[0] ;restore next ERR up the chain
MOV ESP,EBP
POP EBP
RET
;****************************************************
HANDLER:
RET

Do-wan Kim

2013-11-21 09:58

reporter  

fpc_win32_per_thread_seh.zip (16,723 bytes)

Do-wan Kim

2013-11-21 10:01

reporter   ~0071466

Win32 SEH per thread is easy than I think xD
Example uploaded.

Do-wan Kim

2013-11-22 07:18

reporter  

fpc_win32_per_thread.patch (7,480 bytes)
Index: rtl/i386/setjump.inc
===================================================================
--- rtl/i386/setjump.inc	(revision 26118)
+++ rtl/i386/setjump.inc	(working copy)
@@ -12,8 +12,27 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+ 
+ {$ifdef win32}
+ const
+  _EXCEPTION_MAXIMUM_PARAMETERS=15;
 
+type
+  _PEXCEPTION_RECORD = ^_EXCEPTION_RECORD;
+  _EXCEPTION_RECORD = record
+  ExceptionCode:DWORD;
+  ExceptionFlags:DWORD;
+  ExceptionRecord:_PEXCEPTION_RECORD;
+  ExceptionAddress:Pointer;
+  NumberParameters:DWORD;
+  ExceptionInformation:array[0.._EXCEPTION_MAXIMUM_PARAMETERS-1] of Longword;
+  end;
+  
+function  thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl; forward;
+ {$endif}
+
 Function fpc_SetJmp (Var S : Jmp_buf) : longint;assembler;nostackframe;[Public, alias : 'FPC_SETJMP']; compilerproc;
+label Next0;
 asm
   movl %ebx,Jmp_buf.ebx(%eax)
   movl %esi,Jmp_buf.esi(%eax)
@@ -24,7 +43,23 @@
   movl (%esp),%edi
   movl %edi,Jmp_buf.pc(%eax)
   movl Jmp_buf.edi(%eax),%edi
+  {$ifdef win32}
+  popl %ecx // ret addr
+  pushl %ebp
+  pushl $0
+  pushl $0
+  pushl Jmp_buf.pc(%eax)  // [eax+20]
+  pushl thread_exception_handler
+  pushl %fs:(0)
+  movl %esp,%fs:(0)
+  pushl %ecx // ret addr
+  {$endif}
   xorl %eax,%eax
+  jmp Next0
+  .byte 0x88
+  .byte 0x88
+  .byte 0x99
+Next0:  
 end;
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26118)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,10 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -236,6 +240,12 @@
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
 var
   hp : ^PExceptAddr;
+ (*  
+{$ifdef win32}  
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+{$endif}  
+  *)
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,7 +260,83 @@
     end
   else
     begin
+	  (*
+	  {$ifdef win32}
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  // remove skiped poping
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  // start traverse
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    // exceptstack in stack range
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  // prevent main thread's other thread poping
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=Pointer(cstack);
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;
+	  {$else}
+	  *)
       hp^:=hp^^.Next;
+	  //{$endif}
+// per thread SEH
+  {$ifdef win32}
+  asm
+    (*
+    ebp+20 ebp
+    ebp+1c 0
+    ebp+18 0
+    ebp+14 safe
+    ebp+10 handler
+    ebp+c fs:[0]
+	ebp+8 eax
+    ebp+4 caller
+    ebp ebp
+	*)
+	movl 0xc(%ebp),%eax
+	movl %eax,%fs:(0)
+	movl 0x8(%ebp),%eax
+	movl %eax,0xc(%ebp)
+	movl 0x4(%ebp),%eax
+	movl %eax,0x8(%ebp)
+	movl 0x0(%ebp),%eax
+	movl %eax,0x4(%ebp)
+	addl $0x4,%ebp
+  end;
+  {$endif}		  
     end;
 end;
 
@@ -394,6 +480,9 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  ExceptAddrSkip:=Nil;
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26118)
+++ rtl/win32/system.pp	(working copy)
@@ -513,6 +513,114 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+  // per thread SEH
+procedure RtlUnwind(
+    TargetFrame : PVOID;
+    TargetIp : PVOID;
+    ExceptionRecord : _PEXCEPTION_RECORD;
+    ReturnValue : PVOID
+  ); stdcall; external 'kernel32.dll' name 'RtlUnwind';  
+  
+function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  label unwind_ret;  
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    res := EXCEPTION_CONTINUE_SEARCH;
+	exit(0);
+      err := 0;
+      must_reset_fpu := true;	
+    case ExceptRecord^.ExceptionCode of	
+        STATUS_INTEGER_DIVIDE_BY_ZERO,
+        STATUS_FLOAT_DIVIDE_BY_ZERO :
+          err := 200;
+        STATUS_ARRAY_BOUNDS_EXCEEDED :
+          begin
+            err := 201;
+            must_reset_fpu := false;
+          end;
+        STATUS_STACK_OVERFLOW :
+          begin
+            err := 202;
+            must_reset_fpu := false;
+          end;
+        STATUS_FLOAT_OVERFLOW :
+          err := 205;
+        STATUS_FLOAT_DENORMAL_OPERAND,
+        STATUS_FLOAT_UNDERFLOW :
+          err := 206;	
+        STATUS_FLOAT_INEXACT_RESULT,
+        STATUS_FLOAT_INVALID_OPERATION,
+        STATUS_FLOAT_STACK_CHECK :
+          err := 207;
+        STATUS_INTEGER_OVERFLOW :
+          begin
+            err := 215;
+            must_reset_fpu := false;
+          end;
+        STATUS_ILLEGAL_INSTRUCTION:
+          { if we're testing sse support, simply set the flag and continue }
+          if sse_check then
+            begin
+              os_supports_sse:=false;
+              { skip the offending movaps %xmm7, %xmm6 instruction }
+              inc(PDWORD(Context+$0b8)^,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(pointer(PDWORD(Context+$0b8))) then
+            begin
+              { if yes, then retry }
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;	
+        STATUS_PRIVILEGED_INSTRUCTION:
+          begin
+            err := 218;
+            must_reset_fpu := false;
+          end;
+        else
+          begin
+            if ((ExceptRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
+              err := 217
+            else
+              err := 255;
+          end;	
+	end;
+	
+	if err<>0 then begin
+	    asm
+	    pushl $0
+		pushl ExceptRecord
+		pushl $unwind_ret
+		pushl Frame
+		call RtlUnwind
+		.byte 0x77
+		.byte 0x88
+		.byte 0x99
+		end;
+unwind_ret:
+      PDWORD(Context+$0c4)^:=PtrUInt(Frame);     // esp
+      PDWORD(Context+$0b8)^:=PDWORD(Frame+8)^;   // eip ?
+      PDWORD(context+$0b4)^:=PDWORD(Frame+$14)^; // ebp	
+      //PDWORD(context+$0b0)^:=1;                // eax		
+    if (exceptLevel > 0) then
+      dec(exceptLevel);	  
+    if resetFPU[exceptLevel] then
+      SysResetFPU;	  
+	end;
+	  
+    thread_exception_handler := res;
+  end;
 
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}

Do-wan Kim

2013-11-22 07:23

reporter   ~0071478

Try to install SEH per thread handler at rtl level, but no success.
got runtime error 217 at compile unit.
set_jump, popaddrstack, system.pp was modified.

I give up because I don't know much about this.

Do-wan Kim

2013-11-22 11:59

reporter  

fpc_win32_per_thread_revised.patch (7,702 bytes)
Index: rtl/i386/setjump.inc
===================================================================
--- rtl/i386/setjump.inc	(revision 26118)
+++ rtl/i386/setjump.inc	(working copy)
@@ -12,8 +12,27 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+ 
+  {$ifdef win32}
+ const
+  _EXCEPTION_MAXIMUM_PARAMETERS=15;
 
+type
+  _PEXCEPTION_RECORD = ^_EXCEPTION_RECORD;
+  _EXCEPTION_RECORD = record
+  ExceptionCode:DWORD;
+  ExceptionFlags:DWORD;
+  ExceptionRecord:_PEXCEPTION_RECORD;
+  ExceptionAddress:Pointer;
+  NumberParameters:DWORD;
+  ExceptionInformation:array[0.._EXCEPTION_MAXIMUM_PARAMETERS-1] of Longword;
+  end;
+  
+function  thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl; forward;
+ {$endif}
+
 Function fpc_SetJmp (Var S : Jmp_buf) : longint;assembler;nostackframe;[Public, alias : 'FPC_SETJMP']; compilerproc;
+label Next0;
 asm
   movl %ebx,Jmp_buf.ebx(%eax)
   movl %esi,Jmp_buf.esi(%eax)
@@ -24,7 +43,24 @@
   movl (%esp),%edi
   movl %edi,Jmp_buf.pc(%eax)
   movl Jmp_buf.edi(%eax),%edi
+  {$ifdef win32}
+  popl %edx // ret addr
+  pushl Jmp_buf.bp(%eax)
+  pushl $0
+  pushl $0
+  pushl Jmp_buf.pc(%eax)  // [eax+20]
+  pushl $thread_exception_handler
+  pushl %fs:(0)
+  movl %esp,%fs:(0)
+  pushl %edx // ret addr
+  {$endif}
   xorl %eax,%eax
+  jmp Next0
+  .byte 0x88 // debug
+  .byte 0x88
+  .byte 0x99
+  .byte 0x99
+Next0:  
 end;
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26118)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,10 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -236,6 +240,12 @@
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
 var
   hp : ^PExceptAddr;
+(*  
+{$ifdef win32}  
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+{$endif}  
+*)
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,8 +260,85 @@
     end
   else
     begin
+	(*
+	  {$ifdef win32}
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  // remove skiped poping
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  // start traverse
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    // exceptstack in stack range
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  // prevent main thread's other thread poping
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=Pointer(cstack);
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;
+	  {$else}
+	  *)
       hp^:=hp^^.Next;
+	  //{$endif}
     end;
+// per thread SEH
+  {$ifdef win32}
+  asm
+    {
+    ebp+20 ebp
+    ebp+1c 0
+    ebp+18 0
+    ebp+14 safe
+    ebp+10 handler
+    ebp+c fs:[0]
+	ebp+8 eax
+    ebp+4 caller
+    ebp ebp
+	}
+	movl (%ebp),%eax
+	movl %eax,0x18(%ebp)
+	movl 0x04(%ebp),%eax
+	movl %eax,0x1c(%ebp)
+	movl 0x08(%ebp),%eax
+	movl %eax,0x20(%ebp)
+	movl 0x0c(%ebp),%eax
+	movl %eax,%fs:(0)
+	addl $0x18,%ebp
+  end;
+  {$endif}		  
+
 end;
 
 
@@ -394,6 +481,9 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  ExceptAddrSkip:=Nil;
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26118)
+++ rtl/win32/system.pp	(working copy)
@@ -513,6 +513,122 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+  // per thread SEH
+procedure RtlUnwind(
+    TargetFrame : PVOID;
+    TargetIp : PVOID;
+    ExceptionRecord : _PEXCEPTION_RECORD;
+    ReturnValue : PVOID
+  ); stdcall; external 'kernel32.dll' name 'RtlUnwind';  
+  
+function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  label unwind_ret;  
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    res := EXCEPTION_CONTINUE_SEARCH;
+      err := 0;
+      must_reset_fpu := true;	
+    case ExceptRecord^.ExceptionCode of	
+        STATUS_INTEGER_DIVIDE_BY_ZERO,
+        STATUS_FLOAT_DIVIDE_BY_ZERO :
+          err := 200;
+        STATUS_ARRAY_BOUNDS_EXCEEDED :
+          begin
+            err := 201;
+            must_reset_fpu := false;
+          end;
+        STATUS_STACK_OVERFLOW :
+          begin
+            err := 202;
+            must_reset_fpu := false;
+          end;
+        STATUS_FLOAT_OVERFLOW :
+          err := 205;
+        STATUS_FLOAT_DENORMAL_OPERAND,
+        STATUS_FLOAT_UNDERFLOW :
+          err := 206;	
+        STATUS_FLOAT_INEXACT_RESULT,
+        STATUS_FLOAT_INVALID_OPERATION,
+        STATUS_FLOAT_STACK_CHECK :
+          err := 207;
+        STATUS_INTEGER_OVERFLOW :
+          begin
+            err := 215;
+            must_reset_fpu := false;
+          end;
+        STATUS_ILLEGAL_INSTRUCTION:
+          { if we're testing sse support, simply set the flag and continue }
+          if sse_check then
+            begin
+              os_supports_sse:=false;
+              { skip the offending movaps %xmm7, %xmm6 instruction }
+              inc(PDWORD(Context+$0b8)^,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(pointer(PDWORD(Context+$0b8))) then
+            begin
+              { if yes, then retry }
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;	
+        STATUS_PRIVILEGED_INSTRUCTION:
+          begin
+            err := 218;
+            must_reset_fpu := false;
+          end;
+        else
+          begin
+            if ((ExceptRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
+              err := 217
+            else
+              err := 255;
+          end;	
+	end;
+	
+	if res=EXCEPTION_CONTINUE_EXECUTION then begin
+	    asm
+		pushl %ebx
+		pushl %edi
+		pushl %esi
+	    pushl $0
+		pushl ExceptRecord
+		pushl $unwind_ret
+		pushl Frame
+		call RtlUnwind
+		jmp unwind_ret
+		.byte 0x77 // debug
+		.byte 0x77
+		.byte 0x99
+		.byte 0x99
+unwind_ret:		
+        popl %esi
+		popl %edi
+		popl %ebx
+		end;
+      PDWORD(Context+$0c4)^:=PtrUInt(Frame);     // esp
+      PDWORD(Context+$0b8)^:=PDWORD(Frame+8)^;   // eip ?
+      PDWORD(context+$0b4)^:=PDWORD(Frame+$14)^; // ebp	
+      //PDWORD(context+$0b0)^:=1;                // eax		
+    if (exceptLevel > 0) then
+      dec(exceptLevel);	  
+    if resetFPU[exceptLevel] then
+      SysResetFPU;	  
+	  
+	  thread_exception_handler := 0;	  
+	end else
+	  thread_exception_handler := 1;
+  end;
 
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}

Do-wan Kim

2013-11-24 11:56

reporter   ~0071532

New SEH patch at 0025363
But this problem is always top poping ExceptAddr linked list problem,not a SEH implementation.

Sven Barth

2013-12-16 10:58

manager   ~0071918

FPC now has experimental support for native SEH on Win32. Would you please test FPC 2.7.1 after revision 26225? You'll need to compile the compiler with OPT=-dTEST_WIN32_SEH for this to work.

Regards,
Sven

Sergei Gorelkin

2013-12-16 12:43

developer   ~0071920

SEH support makes the attached test to appear as working. But, as I wrote above, we need to put threadvars into fiber-local storage in order to consider the issue solved.

Max Nazhalov

2013-12-16 14:03

reporter   ~0071922

Last edited: 2013-12-16 15:07

View 5 revisions

@Sergei: well, fibers are NOT separate threads by design -- they are all share the environment of the container-thread [including threadvars], and, yes -- with the help of Fls* API they CAN have its own per-fiber data [but not required to do this]. So using FLS for the purpose other than the particular fiber library implementation is an overshoot IMHO.

Regarding the exception chain -- there should be no problems as long as the head of it is kept in FS:[0]. Windows switches them transparently, if I understand correctly.

BTW, up to and including DelphiXE there is no fiber-related code in the RTL core.

Oh yes, in case if the FPC exception handling mechanism uses TLS on Win32 for storing some of its internal state -- surely it should be moved out to the _EXCEPTION_REGISTRATION record tail from now..

Sergei Gorelkin

2013-12-16 15:56

developer   ~0071925

The SEH exception chain replaces only part of exception-related state, namely ExceptAddrStack. Another part, ExceptObjectStack, remains in TLS and cannot be attached to fs:[0] (moreover, it has to be maintained for Win64 that has no exception registration chain).

Max Nazhalov

2013-12-16 16:21

reporter   ~0071926

Last edited: 2013-12-16 16:31

View 3 revisions

Since every _EXCEPTION_REGISTRATION record is tightly coupled with its handler it can be arbitrary length, and can contain arbitrary data understandable to only the attached handler, except of the first 2 fields expected by OS (linkback and handler pointer). The rest of it has free format, and can be allocated in the stack before pushing the required 2 entities (provided that the handler knows how to deal with that rest and how to clean it up).
I'm not dig this, but guess that wrapping "ExceptObjectStack" into something like "GetExceptObjectStack" which, depending on compilation DEFs, returns the result from TLS, or fetching it from _EXCEPTION_REGISTRATION, will be enough.

Andrey Paramonov

2013-12-19 10:52

reporter   ~0071964

Works very nicely with OPT=-dTEST_WIN32_SEH for me.
Thank you!
Is there reason to keep ExceptAddr in SEH chain but ExceptObjectStack in TLS? I believe if ExceptObject is moved into _EXCEPTION_REGISTRATION then it should be done unconditionally (TEST_WIN32_SEH should move both ExceptAddr and ExceptObject to SEH chain).

Sergei Gorelkin

2013-12-19 11:04

developer   ~0071965

ExceptObjectStack is not a per-frame, but a per-exception data. It is not available when frames are created. And when an exception is raised, it has to be accessible from all frames involved in its handling.

For the same reason local variables are not always sufficient, and sometimes global variables must be used.

Max Nazhalov

2013-12-19 14:55

reporter   ~0071971

Can anyone synthesize an example of the erroneous exception handling to begin with? [I've failed yet..]

Andrey Paramonov

2014-01-09 08:39

reporter   ~0072325

I believe I managed to forge an example of incorrect exception handling in fibers. It's in attachement. I *think* it contains legal code however it fails for me even on Delphi 5 :-/

The code fails in different fashion on different compilers:

Expected:
>fiberdemo.exe
3: EOuterException Outer
1: EInnerException Inner
4: EOuterException Outer
2: EInnerException Inner

Delphi 5:
>fiberdemo.exe
3: EOuterException Outer
1: EInnerException Inner
4: EOuterException Outer
2: EInnerException

Freepascal with TEST_WIN32_SEH:
>fiberdemo.exe
3: EOuterException Outer
1: EInnerException Inner
4: EOuterException Outer
<Unhandled exception>

Freepascal w/o TEST_WIN32_SEH:
>fiberdemo.exe
3: EOuterException Outer
1: EInnerException Inner
4: EOuterException Outer

Best wishes,
Andrey Paramonov

Andrey Paramonov

2014-01-09 08:40

reporter  

fiberdemo.dpr (1,838 bytes)

Marco van de Voort

2014-01-09 13:53

manager   ~0072328

XE3 prints:

3: EOuterException Outer
1: EInnerException Inner
4: EOuterException Outer
2: EInnerException

Max Nazhalov

2014-01-09 15:12

reporter   ~0072331

Last edited: 2014-01-09 15:38

View 3 revisions

@Andrey: what exactly did you meant by "different fashion"?..

guess 1: Delphi output misses the "Inner" after final "2: EInnerException"? (Does it exits normally after all or just silently traps or so?..)

guess 2: "Freepascal w/o TEST_WIN32_SEH" misses that line completely? (--/same Q/--)

Marco van de Voort

2014-01-09 15:39

manager   ~0072333

Max: I double checked it when I wrote it. It is not a copy-and-paste error, delphi misses the "inner".

Max Nazhalov

2014-01-09 15:48

reporter   ~0072334

@Marco: Yes, that is why I asked the author to clarify details imperceptible at the first glance, but may be of significance. ;)

Andrey Paramonov

2014-01-10 08:00

reporter   ~0072346

Delphi misses "Inner", exits normally. But missing "Inner" obviously indicates some kind of mem. corruption, so it would likely fail on more complex example.

Freepascal w/o TEST_WIN32_SEH misses the line completely, but seems to exit normally. I wouldn't pay much attention to this one as it cannot support fibers properly anyway.

Freepascal with TEST_WIN32_SEH crashes before last Writeln.

Freepascal is of version 2.7.1.

Hope I managed to make it more clear ;-)
Andrey Paramonov

Cyrax

2014-01-21 06:04

reporter   ~0072575

Target system: win32, Free Pascal trunk 2.7.1-r26529, Lazarus trunk '1.3'-r43774
fpc make options
   make all install sourceinstall UPXPROG=echo OPT="-gw2 -godwarfsets -gl -O- -OoNO -Xs- -vb -dTEST_WIN32_SEH" COMPILER_OPTIONS="-gw2 -godwarfsets -gl -O- -OoNO -Xs- -vb -dTEST_WIN32_SEH" INSTALL_PREFIX=i:\free_pascal_and_lazarus\free_pascal_and_lazarus\fpc\trunk\build\trunk_x32 REVSTR=26529 IDE=1
lazarus make options
   make all UPXPROG=echo OPT="-gw2 -godwarfsets -gh -gl -O- -OoNO -dHEAPTRC_WINDOW -Xs- -vb -dTEST_WIN32_SEH" USESVN2REVISIONINC=0

--

Here is call stack for that crash:

#0 fpc_shortstr_to_shortstr('', 255, <error reading variable: Cannot access memory at address 0xff>) at ..\i386\i386.inc:805
0000001 CLASSNAME(0x30c3f4) at ..\inc\objpas.inc:519
0000002 $FIBERDEMO$_Lj87(0x30c3c8) at fiberdemo.dpr:58
0000003 KERNEL32!CreateFiberEx at :0
0000004 KERNEL32!CreateFiberEx at :0

Cyrax

2014-01-21 06:45

reporter  

updated_fiberdemo.zip (1,809 bytes)

Cyrax

2014-01-21 06:46

reporter   ~0072576

Attached updated fiberdemo.

Marco van de Voort

2018-07-27 18:34

manager   ~0109712

Current output :
3: EOuterException Outer
1: EAccessViolation Access violation
4: EOuterException Outer

If I run through gdb, there are 3 SIGSEGV's between 3 and 1, and two after 4.

Max Nazhalov

2019-10-11 19:32

reporter   ~0118495

Just a sidenote..
https://devblogs.microsoft.com/oldnewthing/20191011-00/?p=102989

and the linked one
http://www.open-std.org/JTC1/SC22/WG21/docs/papers/2018/p1364r0.pdf

Issue History

Date Modified Username Field Change
2013-11-12 13:18 Andrey Paramonov New Issue
2013-11-12 13:18 Andrey Paramonov File Added: fiberdemo.lpr
2013-11-12 16:36 Max Nazhalov Note Added: 0071280
2013-11-13 08:58 Do-wan Kim Note Added: 0071297
2013-11-13 13:11 Andrey Paramonov Note Added: 0071298
2013-11-13 13:19 Andrey Paramonov Note Edited: 0071298 View Revisions
2013-11-13 13:22 Andrey Paramonov Note Edited: 0071298 View Revisions
2013-11-13 13:24 Max Nazhalov Note Added: 0071299
2013-11-13 13:53 Andrey Paramonov Note Added: 0071300
2013-11-13 14:26 Max Nazhalov Note Added: 0071301
2013-11-13 14:27 Max Nazhalov Note Edited: 0071301 View Revisions
2013-11-13 22:59 Do-wan Kim Note Added: 0071304
2013-11-14 01:36 Do-wan Kim Note Edited: 0071304 View Revisions
2013-11-14 05:59 Do-wan Kim Note Edited: 0071304 View Revisions
2013-11-14 06:03 Do-wan Kim Note Edited: 0071304 View Revisions
2013-11-14 07:18 Andrey Paramonov Note Added: 0071305
2013-11-14 08:59 Do-wan Kim Note Added: 0071308
2013-11-14 09:18 Sven Barth Note Added: 0071309
2013-11-15 01:58 Do-wan Kim Note Added: 0071320
2013-11-15 01:59 Do-wan Kim Note Edited: 0071320 View Revisions
2013-11-15 06:44 Do-wan Kim Note Edited: 0071320 View Revisions
2013-11-15 07:51 Sven Barth Note Added: 0071321
2013-11-15 11:07 Do-wan Kim Note Added: 0071324
2013-11-16 00:28 Sergei Gorelkin Note Added: 0071329
2013-11-16 05:07 Do-wan Kim Note Added: 0071330
2013-11-16 07:55 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-16 10:31 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-16 10:34 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-16 10:44 Do-wan Kim File Added: fiberdemo_int.zip
2013-11-17 01:17 Do-wan Kim File Added: fiberdemo_except_fault.png
2013-11-17 01:19 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-17 06:11 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-17 06:12 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-17 10:56 Do-wan Kim Note Edited: 0071330 View Revisions
2013-11-17 11:46 Sergei Gorelkin Note Added: 0071351
2013-11-19 15:34 Andrey Paramonov Note Added: 0071400
2013-11-19 15:35 Andrey Paramonov File Added: iterimpl.pas
2013-11-19 15:36 Andrey Paramonov File Added: baseiter.pas
2013-11-19 15:36 Andrey Paramonov File Added: iterdemo.lpr
2013-11-19 21:36 Sven Barth Note Added: 0071401
2013-11-19 21:36 Sven Barth Relationship added related to 0012974
2013-11-20 02:28 Do-wan Kim Note Added: 0071406
2013-11-20 02:29 Do-wan Kim Note Edited: 0071406 View Revisions
2013-11-20 03:10 Do-wan Kim Note Edited: 0071406 View Revisions
2013-11-20 04:03 Do-wan Kim Note Edited: 0071406 View Revisions
2013-11-20 05:33 Do-wan Kim File Added: except.inc_win32.patch
2013-11-20 09:51 Do-wan Kim Note Edited: 0071406 View Revisions
2013-11-20 11:26 Do-wan Kim File Added: except.inc_win32_new.patch
2013-11-20 12:27 Do-wan Kim File Added: iterdemo_w32_work.zip
2013-11-20 12:30 Do-wan Kim Note Edited: 0071406 View Revisions
2013-11-20 13:13 Andrey Paramonov Note Added: 0071417
2013-11-20 14:23 Do-wan Kim Note Added: 0071419
2013-11-20 19:22 Andrey Paramonov Note Added: 0071440
2013-11-20 23:58 Do-wan Kim Note Added: 0071449
2013-11-21 00:10 Do-wan Kim Note Edited: 0071449 View Revisions
2013-11-21 05:08 Do-wan Kim Note Edited: 0071449 View Revisions
2013-11-21 09:58 Do-wan Kim File Added: fpc_win32_per_thread_seh.zip
2013-11-21 10:01 Do-wan Kim Note Added: 0071466
2013-11-22 07:18 Do-wan Kim File Added: fpc_win32_per_thread.patch
2013-11-22 07:23 Do-wan Kim Note Added: 0071478
2013-11-22 11:59 Do-wan Kim File Added: fpc_win32_per_thread_revised.patch
2013-11-24 11:56 Do-wan Kim Note Added: 0071532
2013-11-24 13:51 Jonas Maebe Relationship added related to 0025363
2013-12-16 10:58 Sven Barth Note Added: 0071918
2013-12-16 10:58 Sven Barth Assigned To => Sven Barth
2013-12-16 10:58 Sven Barth Status new => feedback
2013-12-16 12:43 Sergei Gorelkin Note Added: 0071920
2013-12-16 14:03 Max Nazhalov Note Added: 0071922
2013-12-16 14:18 Max Nazhalov Note Edited: 0071922 View Revisions
2013-12-16 14:30 Max Nazhalov Note Edited: 0071922 View Revisions
2013-12-16 14:40 Max Nazhalov Note Edited: 0071922 View Revisions
2013-12-16 15:07 Max Nazhalov Note Edited: 0071922 View Revisions
2013-12-16 15:56 Sergei Gorelkin Note Added: 0071925
2013-12-16 16:21 Max Nazhalov Note Added: 0071926
2013-12-16 16:24 Max Nazhalov Note Edited: 0071926 View Revisions
2013-12-16 16:31 Max Nazhalov Note Edited: 0071926 View Revisions
2013-12-19 10:52 Andrey Paramonov Note Added: 0071964
2013-12-19 10:52 Andrey Paramonov Status feedback => assigned
2013-12-19 11:04 Sergei Gorelkin Note Added: 0071965
2013-12-19 14:55 Max Nazhalov Note Added: 0071971
2014-01-09 08:39 Andrey Paramonov Note Added: 0072325
2014-01-09 08:40 Andrey Paramonov File Added: fiberdemo.dpr
2014-01-09 13:53 Marco van de Voort Note Added: 0072328
2014-01-09 15:12 Max Nazhalov Note Added: 0072331
2014-01-09 15:13 Max Nazhalov Note Edited: 0072331 View Revisions
2014-01-09 15:38 Max Nazhalov Note Edited: 0072331 View Revisions
2014-01-09 15:39 Marco van de Voort Note Added: 0072333
2014-01-09 15:48 Max Nazhalov Note Added: 0072334
2014-01-10 08:00 Andrey Paramonov Note Added: 0072346
2014-01-21 06:04 Cyrax Note Added: 0072575
2014-01-21 06:45 Cyrax File Added: updated_fiberdemo.zip
2014-01-21 06:46 Cyrax Note Added: 0072576
2018-07-27 18:34 Marco van de Voort Note Added: 0109712
2019-10-11 19:32 Max Nazhalov Note Added: 0118495