View Issue Details

IDProjectCategoryView StatusLast Update
0025363FPCCompilerpublic2016-11-13 23:00
ReporterDo-wan Kim Assigned ToSergei Gorelkin  
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Platformx86OSWindows 
Product Version2.7.1 
Fixed in Version3.0.0 
Summary0025363: win32 per thread SEH implemantaion.
Descriptionwin32 per thread SEH implementation.

DLL exception problem is gone, but more testing is needed.

currently works fine for me.
TagsNo tags attached.
Fixed in Revision26225
FPCOldBugId
FPCTarget
Attached Files

Relationships

related to 0012974 resolvedJoost van der Sluis FPC can't catch windows exceptions (av's) in a try/except in a dll call 
related to 0025312 assignedSven Barth Unhandled exception when using w32 fiber API 

Activities

Do-wan Kim

2013-11-24 10:38

reporter  

win32_seh_per_thread.patch (10,047 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26127)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,19 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
@@ -465,10 +481,27 @@
 
 
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+      {$ifdef Use_win32_seh}
+	  var
+        paraloc1 : tcgpara;
+        pd: tprocdef;
+	  {$endif}
      begin
+	     {$ifdef Use_win32_seh}
+         pd:=search_system_proc('fpc_popaddrstackseh');
+		 paraloc1.init;
+         paramanager.getintparaloc(pd,1,paraloc1);
+         cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc1);
+         paramanager.freecgpara(list,paraloc1);
          cg.allocallcpuregisters(list);
+         cg.a_call_name(list,'FPC_POPADDRSTACKSEH',false);
+         cg.deallocallcpuregisters(list);
+		 paraloc1.done;
+		 {$else}
+         cg.allocallcpuregisters(list);
          cg.a_call_name(list,'FPC_POPADDRSTACK',false);
          cg.deallocallcpuregisters(list);
+		 {$endif}
 
          if not onlyfree then
           begin
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26127)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -16,7 +16,7 @@
 Type
   jmp_buf = packed record
     ebx,esi,edi : Longint;
-    bp,sp,pc : Pointer;
+    bp,sp,pc {$ifdef win32}{$ifdef win32_seh} ,fs,exrec,frame,d1,d2 {$endif}{$endif} : Pointer;
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26127)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,12 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26127)
+++ rtl/inc/except.inc	(working copy)
@@ -84,7 +84,68 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl $0,0x28(%eax)    // d2
+  movl $0,0x24(%eax)    // d1
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+var
+  hp : ^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
+      hp^:=hp^^.Next;
+    end;
+  asm
+    movl buf,%eax
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+  end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26127)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,7 @@
     end;
   end;
 
+{$ifndef win32_seh}
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +514,111 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+  
+  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
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}
win32_seh_per_thread.patch (10,047 bytes)   

Do-wan Kim

2013-11-24 10:40

reporter  

dlltest_new_patch.zip (60,562 bytes)

Do-wan Kim

2013-11-24 10:42

reporter   ~0071528

Global define '-dwin32_seh' switch is need.

Do-wan Kim

2013-11-24 13:00

reporter  

win32_seh_per_thread_and_list.patch (11,609 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26127)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,19 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
@@ -465,10 +481,27 @@
 
 
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+      {$ifdef Use_win32_seh}
+	  var
+        paraloc1 : tcgpara;
+        pd: tprocdef;
+	  {$endif}
      begin
+	     {$ifdef Use_win32_seh}
+         pd:=search_system_proc('fpc_popaddrstackseh');
+		 paraloc1.init;
+         paramanager.getintparaloc(pd,1,paraloc1);
+         cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc1);
+         paramanager.freecgpara(list,paraloc1);
          cg.allocallcpuregisters(list);
+         cg.a_call_name(list,'FPC_POPADDRSTACKSEH',false);
+         cg.deallocallcpuregisters(list);
+		 paraloc1.done;
+		 {$else}
+         cg.allocallcpuregisters(list);
          cg.a_call_name(list,'FPC_POPADDRSTACK',false);
          cg.deallocallcpuregisters(list);
+		 {$endif}
 
          if not onlyfree then
           begin
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26127)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -16,7 +16,7 @@
 Type
   jmp_buf = packed record
     ebx,esi,edi : Longint;
-    bp,sp,pc : Pointer;
+    bp,sp,pc {$ifdef win32}{$ifdef win32_seh} ,fs,exrec,frame,d1,d2 {$endif}{$endif} : Pointer;
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26127)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,12 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26127)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,12 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +90,115 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl $0,0x28(%eax)    // d2
+  movl $0,0x24(%eax)    // d1
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+var
+  hp : ^PExceptAddr;
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+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
+	  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;	
+    end;
+  asm
+    movl buf,%eax
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+  end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -394,6 +508,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26127)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,7 @@
     end;
   end;
 
+{$ifndef win32_seh}
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +514,111 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+  
+  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
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}

Sven Barth

2013-11-24 18:41

manager   ~0071553

While I appreciate your work it nevertheless looks like a "quick and dirty" solution to me.

A full implementation of SEH for i386-win32 should override the corresponding code generation nodes (ttryexceptnode, ttryfinallynode, traisenode and tonnode) like the x86_64 code generator does to implement SEH for Win64.

Regards,
Sven

Do-wan Kim

2013-11-25 03:54

reporter   ~0071569

Thank you for advice :)

I found missing part of flow control(break,exit,continue) and refine patch.

Do-wan Kim

2013-11-25 03:54

reporter  

win32_seh_per_thread_and_list_new.patch (11,037 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26134)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,19 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26134)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -16,7 +16,7 @@
 Type
   jmp_buf = packed record
     ebx,esi,edi : Longint;
-    bp,sp,pc : Pointer;
+    bp,sp,pc {$ifdef win32}{$ifdef win32_seh} ,fs,exrec,frame,d1,d2 {$endif}{$endif} : Pointer;
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26134)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,11 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{$ifdef win32}
+  {$ifdef win32_seh}
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26134)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,12 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +90,42 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl $0,0x28(%eax)    // d2
+  movl $0,0x24(%eax)    // d1
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -234,8 +275,15 @@
 
 
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
+label buf_nil_0,buf_nil_1;
 var
   hp : ^PExceptAddr;
+{$ifdef win32}
+  {$ifdef win32_seh}
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;  
+  {$endif}
+{$endif}  
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,7 +298,80 @@
     end
   else
     begin
+	  {$ifdef win32}
+	    {$ifdef win32_seh}
+	  // get stack
+	  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
+		  // remove handler
+		  prev:=hp^;
+		  asm
+			movl prev,%eax
+			testl %eax,%eax
+			jz buf_nil_0
+			movl Jmp_buf.fs(%eax),%eax
+			movl %eax,%fs:(0)
+		  buf_nil_0:	
+		  end;		
+		  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
+		  // remove handler
+		  asm
+			movl curr,%eax
+			testl %eax,%eax
+			jz buf_nil_1
+			movl Jmp_buf.fs(%eax),%eax
+			movl %eax,%fs:(0)
+		  buf_nil_1:	
+		  end;				
+		  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}
+	  {$else}
+      hp^:=hp^^.Next;	  
+	  {$endif}
     end;
 end;
 
@@ -394,6 +515,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26134)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,7 @@
     end;
   end;
 
+{$ifndef win32_seh}
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +514,111 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+  
+  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
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}

Do-wan Kim

2013-11-25 05:03

reporter  

win32_seh_per_thread_and_list_newfix.patch (11,095 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26134)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,19 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26134)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -16,7 +16,7 @@
 Type
   jmp_buf = packed record
     ebx,esi,edi : Longint;
-    bp,sp,pc : Pointer;
+    bp,sp,pc {$ifdef win32}{$ifdef win32_seh} ,fs,exrec,frame,d1,d2 {$endif}{$endif} : Pointer;
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26134)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,11 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{$ifdef win32}
+  {$ifdef win32_seh}
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26134)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,12 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +90,42 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl $0,0x28(%eax)    // d2
+  movl $0,0x24(%eax)    // d1
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -234,8 +275,15 @@
 
 
 Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; compilerproc;
+label buf_nil_0,buf_nil_1;
 var
   hp : ^PExceptAddr;
+{$ifdef win32}
+  {$ifdef win32_seh}
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;  
+  {$endif}
+{$endif}  
 begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
@@ -250,7 +298,84 @@
     end
   else
     begin
+	  {$ifdef win32}
+	    {$ifdef win32_seh}
+	  // get stack
+	  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
+		  // remove handler
+		  prev:=hp^;
+		  asm
+		    pushl %eax
+			movl prev,%eax
+			testl %eax,%eax
+			jz buf_nil_0
+			movl Jmp_buf.fs(%eax),%eax
+			movl %eax,%fs:(0)
+		  buf_nil_0:	
+		    popl %eax
+		  end;		
+		  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
+		  // remove handler
+		  asm
+		    pushl %eax
+			movl curr,%eax
+			testl %eax,%eax
+			jz buf_nil_1
+			movl Jmp_buf.fs(%eax),%eax
+			movl %eax,%fs:(0)
+		  buf_nil_1:	
+		    popl %eax
+		  end;				
+		  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:=curr;
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;	
+        {$else}	  
       hp^:=hp^^.Next;
+	    {$endif}
+	  {$else}
+      hp^:=hp^^.Next;	  
+	  {$endif}
     end;
 end;
 
@@ -394,6 +519,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26134)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,7 @@
     end;
   end;
 
+{$ifndef win32_seh}
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +514,111 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+  
+  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
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}

Do-wan Kim

2013-11-25 10:49

reporter  

win32_seh_perthread_final.patch (12,380 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26134)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,20 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{ save fs:(0) and setup exception handling, return jmpbuf }
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
@@ -465,10 +482,28 @@
 
 
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+      {$ifdef Use_win32_seh}
+	  var
+        paraloc1 : tcgpara;
+        pd: tprocdef;
+	  {$endif}
      begin
+	     { free exception handler and restore prev value }
+	     {$ifdef Use_win32_seh}
+         pd:=search_system_proc('fpc_popaddrstackseh');
+		 paraloc1.init;
+         paramanager.getintparaloc(pd,1,paraloc1);
+         cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc1);
+         paramanager.freecgpara(list,paraloc1);
          cg.allocallcpuregisters(list);
+         cg.a_call_name(list,'FPC_POPADDRSTACKSEH',false);
+         cg.deallocallcpuregisters(list);
+		 paraloc1.done;
+		 {$else}
+         cg.allocallcpuregisters(list);
          cg.a_call_name(list,'FPC_POPADDRSTACK',false);
          cg.deallocallcpuregisters(list);
+		 {$endif}
 
          if not onlyfree then
           begin
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26134)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -17,6 +17,12 @@
   jmp_buf = packed record
     ebx,esi,edi : Longint;
     bp,sp,pc : Pointer;
+	{ fs:(0) stored here. compiler reserves stack, you cannot walk with push/pop on a stack. }
+	{$ifdef win32}
+	{$ifdef win32_seh}
+	fs, Handler, Frame : Pointer;
+	{$endif}
+	{$endif}
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26134)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,13 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{ New functions for win32 seh }
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26134)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,13 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  { for out of range stackframe checking. }
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +91,126 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+{ save fs:(0) and setup Handler }
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+{ restore handler, it must be difference with fpc_popaddrstack.
+  it's only work on free_exceptionhandler. }
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+label skip_fs_load;
+var
+  hp : ^PExceptAddr;
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+begin
+{$ifdef excdebug}
+  writeln ('In Popaddrstack');
+{$endif}
+  { restore from current buf at stack
+   linked list sometimes got bad value (with fiber) }
+  asm
+    pushl %eax
+    movl buf,%eax
+	testl %eax,%eax
+	jz skip_fs_load
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+skip_fs_load:	
+	popl %eax
+  end;
+  hp:=@ExceptAddrStack;
+  If hp^=nil then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionAddresStack');
+{$endif}
+      halt (255);
+    end
+  else
+    begin
+	  { get stack information }
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  { free previous skipped out of stack exceptframe. }
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		{ Is bad stack frame on same ranges? I don't know. }
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  { start except stack checking }
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    { check valid range of stack }
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  { get prev value and break }
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  { most out of stack value above range like thread, skip it }
+		  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;	
+    end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -394,6 +520,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26134)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,8 @@
     end;
   end;
 
+{$ifndef win32_seh}
+// final exception handler
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +515,110 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+// per thread exception handler
+  function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}
win32_seh_perthread_final.patch (12,380 bytes)   

Do-wan Kim

2013-11-25 10:55

reporter   ~0071573

Last edited: 2013-11-25 10:56

View 2 revisions

debug some examples, first method work fine for every situation xD.
revert back and correct some parts.

first method not update handler with fpc_popaddrstack call,and it only updated by fpc_popaddrstackseh. it is not updating handler is not need.

Modifying on new_exception and free_exception is the best thing I do T_T, sorry.

Do-wan Kim

2013-11-25 11:19

reporter  

win32_seh_perthread_final_0.patch (12,369 bytes)   
Index: compiler/ncgutil.pas
===================================================================
--- compiler/ncgutil.pas	(revision 26134)
+++ compiler/ncgutil.pas	(working copy)
@@ -23,6 +23,12 @@
 
 {$i fpcdefs.inc}
 
+{$ifdef win32}
+  {$ifdef win32_seh}
+  {$define Use_win32_seh}
+  {$endif}
+{$endif}  
+
 interface
 
     uses
@@ -117,12 +123,12 @@
       be modified, all temps should be allocated on the heap instead of the
       stack. }
     const
-      EXCEPT_BUF_SIZE = 3*sizeof(pint);
+      EXCEPT_BUF_SIZE = 3*sizeof(pint);	  
     type
       texceptiontemps=record
         jmpbuf,
         envbuf,
-        reasonbuf  : treference;
+        reasonbuf : treference;
       end;
 
     procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
@@ -418,7 +424,7 @@
         paraloc1,paraloc2,paraloc3 : tcgpara;
         pd: tprocdef;
       begin
-        pd:=search_system_proc('fpc_pushexceptaddr');
+        pd:=search_system_proc('fpc_pushexceptaddr');		
         paraloc1.init;
         paraloc2.init;
         paraloc3.init;
@@ -443,9 +449,20 @@
         paramanager.freecgpara(list,paraloc2);
         paramanager.freecgpara(list,paraloc1);
         cg.allocallcpuregisters(list);
-        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
         cg.deallocallcpuregisters(list);
-
+		
+		{ save fs:(0) and setup exception handling, return jmpbuf }
+		{$ifdef Use_win32_seh}
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		{$endif}		
+		
         pd:=search_system_proc('fpc_setjmp');
         paramanager.getintparaloc(pd,1,paraloc1);
         cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
@@ -465,10 +482,28 @@
 
 
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+      {$ifdef Use_win32_seh}
+	  var
+        paraloc1 : tcgpara;
+        pd: tprocdef;
+	  {$endif}
      begin
+	     { free exception handler and restore prev value }
+	     {$ifdef Use_win32_seh}
+         pd:=search_system_proc('fpc_popaddrstackseh');
+		 paraloc1.init;
+         paramanager.getintparaloc(pd,1,paraloc1);
+         cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc1);
+         paramanager.freecgpara(list,paraloc1);
          cg.allocallcpuregisters(list);
+         cg.a_call_name(list,'FPC_POPADDRSTACKSEH',false);
+         cg.deallocallcpuregisters(list);
+		 paraloc1.done;
+		 {$else}
+         cg.allocallcpuregisters(list);
          cg.a_call_name(list,'FPC_POPADDRSTACK',false);
          cg.deallocallcpuregisters(list);
+		 {$endif}
 
          if not onlyfree then
           begin
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26134)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -17,6 +17,12 @@
   jmp_buf = packed record
     ebx,esi,edi : Longint;
     bp,sp,pc : Pointer;
+	{ fs:(0) stored here. compiler reserves stack, you cannot walk with push/pop on a stack. }
+	{$ifdef win32}
+	{$ifdef win32_seh}
+	fs, Handler, Frame : Pointer;
+	{$endif}
+	{$endif}
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26134)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,13 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{ New functions for win32 seh }
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26134)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,13 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  { for out of range stackframe checking. }
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +91,126 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+{ save fs:(0) and setup Handler }
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+{ restore handler, it must be difference with fpc_popaddrstack.
+  it's only work on free_exceptionhandler. }
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+label skip_fs_load;
+var
+  hp : ^PExceptAddr;
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+begin
+{$ifdef excdebug}
+  writeln ('In Popaddrstack');
+{$endif}
+  { restore from current buf at stack
+   linked list sometimes got bad value (with fiber) }
+  asm
+    pushl %eax
+    movl buf,%eax
+	testl %eax,%eax
+	jz skip_fs_load
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+skip_fs_load:	
+	popl %eax
+  end;
+  hp:=@ExceptAddrStack;
+  If hp^=nil then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionAddresStack');
+{$endif}
+      halt (255);
+    end
+  else
+    begin
+	  { get stack information }
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  { free previous skipped out of stack exceptframe. }
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		{ Is bad stack frame on same ranges? I don't know. }
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  { start except stack checking }
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    { check valid range of stack }
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  { get prev value and break }
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  { most out of stack value above range like thread, skip it }
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=curr;
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;	
+    end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -394,6 +520,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26134)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,8 @@
     end;
   end;
 
+{$ifndef win32_seh}
+// final exception handler
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +515,110 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+// per thread exception handler
+  function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}

Sven Barth

2013-11-25 16:10

manager   ~0071588

Take a look at %fpcdir%\compiler\x86_64\nx64flw.pas where the nodes I mentioned are declared and the SEH handling for Win64 is done. This would need to be implemented analogous for Win32 (of course adjusted for the i386 variation of exception handling) in %fpcdir%\compiler\i386\n386flw.pas (which does not exist yet).
The RTL part of the Win64 SEH implementation is located in %fpcdir%\rtl\win64\seh64.inc.

Regards,
Sven

Do-wan Kim

2013-11-26 02:06

reporter  

win32seh.zip (8,850 bytes)

Do-wan Kim

2013-11-26 02:12

reporter   ~0071599

I understood lately compiler classes was there.
Make n386flw.pas and copy and paste some code xD

Thank you in advance :)

Sven Barth

2013-11-26 07:56

manager   ~0071604

Now we are moving into the right direction. :)

Some Points that should be addressed:
- try to get rid of the setjump/longjump usage; the use of SEH32 is afterall to *replace* the usage of jumps (so the functions new_exception and free_exception you copied should be gone in the end, too)
- use the WinAPI function RaiseException ( http://msdn.microsoft.com/en-us/library/windows/desktop/ms680552%28v=vs.85%29.aspx ) to raise FPC exceptions; the implementation should be similar to %fpcdir%\rtl\win64\seh64.inc (maybe you should add a %fpcdir%\rtl\win32\seh32.inc file where such code will be contained); you can/should use the exception code declared in seh64.inc

Regards,
Sven

Do-wan Kim

2013-11-26 10:16

reporter   ~0071609

seh64.inc codes are hard to understanding T_T
I think current coexistance with setjmp/longjmp is not bad xD

Andrey Paramonov

2013-11-26 11:44

reporter   ~0071610

Thank you a lot for your effort, Mr. Kim!

An important thing to consider is support for SEHOP feature. It's by default on on recent server-flavour Microsoft Windows, however you can also enable it on regular Windows 7/8 by creating registry key
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\kernel\DisableExceptionChainValidation
with value 0.

SEHOP principle is described in detail here:
http://blogs.technet.com/b/srd/archive/2009/02/02/preventing-the-exploitation-of-seh-overwrites-with-sehop.aspx

In a gist, SEH chain must conform to the following requirements:
1) All EXCEPTION_REGISTRATION_RECORDs must be allocated on the current stack (inbetween StackBase and StackLimit).
2) The last EXCEPTION_REGISTRATION_RECORD must contain values
pNext = $FFFFFFFF,
pHandler = ntdll.dll!FinalExceptionHandler.

Thank you again for your contributions!

Sven Barth

2013-11-26 12:19

manager   ~0071612

@Do-wan Kim:
No, it's bad, because SEH does not need setjmp/longjmp.

Let's try to do this from a different side. Suppose you have this code:

=== code begin ===

try {1}
  try {2}
    try {3}
      raise Exception.Create('Hello World');
    finally
      Writeln('Foo');
    end;
  except
    on e: Exception do
      Writeln('Bar');
  end;
finally
  Writeln('Foobar');
end;

=== code end ===

Then a naive implementation of SEH (which should be sufficient for now; optimizations can be done later) should create 3 exception frames for each try-block. So for each try-finally or try-except we need to:
1. generate the handler function (the code inside the finally-end or except-end)
2. call a function (compilerproc) to push a new frame with the handler to the exception chain in %fs:(0)
3. execute the code inside the try-finally or try-except
4. call a function (compilerproc) to remove the frame again

The frame thereby contains the pointer to the next exception frame and a pointer to the handler. Additionally we add (afterall we define the size of the entry ourselves) a variable which allows us to differentiate between a FINALLY, a catch all EXCEPT and a filtered (on ...) except (you can see this as SCOPE_... constants in SEH64.inc).

The handler pointer is generated by the nodes in n386flw.pas (see the call to generate_exceptfilter in the x86_64 version of tcgtryexceptnode and tcgtryfinallynode).

The important points of SEH64.inc you'll need are FPC_RaiseException, FPC_ReRaise (maybe also FPC_ReRaise_Implicit, but we'll see...) and __FPC_specific_handler.
Unlike Win64 you'll need to use RtlUnwind though (see http://msdn.microsoft.com/en-us/library/windows/desktop/ms680609%28v=vs.85%29.aspx )

Additionally I suggest you to read http://www.microsoft.com/msj/0197/Exception/Exception.aspx if you haven't done so already.

Regards,
Sven

Sven Barth

2013-11-26 12:46

manager   ~0071613

Small correction:
You set the handler of the exception frame to __FPC_specific_handler and add the filter class type and the filter handler as additional fields to the exception frame (this is what is checked inside FilterException in seh64.inc).

Regards,
Sven

Do-wan Kim

2013-11-26 14:42

reporter   ~0071615

@Andrey
I forgot SEHOP. insert fake handler at start may solve problem like D Language.

@Sven
My Implementaion stores handler pointer in jmp_buf, it coexistance with setjmp/longjmp.
And I check with ollydbg debugger, there is a no matching save/restore handler problem. ollydbg 2.01 has good SEH listing feature :)

Raise Exception and Unwind is my difficult point.

Sven Barth

2013-11-26 14:50

manager   ~0071616

Yes, I see that you store handler pointer in jmp_buf, but that is absolutely unnecessary (besides this being an absolute misuse of jmp_buf). We don't need jmp_buf anymore for exception handling when SEH is used.

Raise Exception can be done analogous to Win64 (see fpc_RaiseException in seh64.inc).
For unwind you need to check whether the OS is currently only checking whether you would handle the exception ("finally" frames return EXCEPTION_CONTINUE_SEARCH, filter frames need to check whether they "fire" (you can use FilterException from seh64.inc for this) (otherwise they return EXCEPTION_CONTINUE_SEARCH as well) and catch all do of course always handle all exceptions. If the handler is called with EXCEPTION_UNWIND you need to execute all finally-handlers and the filter- or catch-all-handler that fired (could be that none fired, because the exception is handled by a different module).

Regards,
Sven

Do-wan Kim

2013-11-26 16:38

reporter  

win32_seh_perthread_final_sehop.patch (11,298 bytes)   
Index: compiler/i386/cpunode.pas
===================================================================
--- compiler/i386/cpunode.pas	(revision 26139)
+++ compiler/i386/cpunode.pas	(working copy)
@@ -55,6 +55,9 @@
        n386set,
        n386inl,
        n386mat
+{$ifdef win32_seh}
+      , n386flw
+{$endif}
        ;
 
 end.
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26139)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -17,6 +17,12 @@
   jmp_buf = packed record
     ebx,esi,edi : Longint;
     bp,sp,pc : Pointer;
+	{ fs:(0) stored here. compiler reserves stack, you cannot walk with push/pop on a stack. }
+	{$ifdef win32}
+	{$ifdef win32_seh}
+	fs, Handler, Frame : Pointer;
+	{$endif}
+	{$endif}
     end;
   PJmp_buf = ^jmp_buf;
 
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26139)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,13 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{ New functions for win32 seh }
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26139)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,13 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  { for out of range stackframe checking. }
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +91,127 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+{ save fs:(0) and setup Handler }
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl %eax,%edx
+  movl (%eax),%eax
+  movl %edx,0x20(%eax)  // stackframe ; useless? ;D
+  movl $thread_exception_handler,0x1c(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,0x18(%eax)  // get and save handler
+  leal 0x18(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+
+{ restore handler, it must be difference with fpc_popaddrstack.
+  it's only work on free_exceptionhandler. }
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+label skip_fs_load;
+var
+  hp : ^PExceptAddr;
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+begin
+{$ifdef excdebug}
+  writeln ('In Popaddrstack');
+{$endif}
+  { restore from current buf at stack
+   linked list sometimes got bad value (with fiber) }
+  asm
+    pushl %eax
+    movl buf,%eax
+	testl %eax,%eax
+	jz skip_fs_load
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+skip_fs_load:	
+	popl %eax
+  end;
+  hp:=@ExceptAddrStack;
+  If hp^=nil then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionAddresStack');
+{$endif}
+      halt (255);
+    end
+  else
+    begin
+	  { get stack information }
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  { free previous skipped out of stack exceptframe. }
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		{ Is bad stack frame on same ranges? I don't know. }
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  { start except stack checking }
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    { check valid range of stack }
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  { get prev value and break }
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  { most out of stack value above range like thread, skip it }
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=curr;
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;	
+    end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -394,6 +521,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26139)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,8 @@
     end;
   end;
 
+{$ifndef win32_seh}
+// final exception handler
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +515,110 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+// per thread exception handler
+  function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}
Index: rtl/win/systhrd.inc
===================================================================
--- rtl/win/systhrd.inc	(revision 26139)
+++ rtl/win/systhrd.inc	(working copy)
@@ -190,6 +190,35 @@
           end;
       end;
 
+{$ifdef win32_seh}
+	type
+	  PExceptionRegister=^TExceptionRegister;
+	  TExceptionRegister = record
+		Prev:PExceptionRegister;
+		Handler:Pointer;
+	  end;
+	  
+	const
+	  FinalPointer=Pointer(-1);	  
+  
+	function Get_FinalExceptionHandler:Pointer;
+	var
+	  Exp:PExceptionRegister;
+	begin
+	  asm
+		movl %fs:(0),%eax
+		movl %eax,exp
+	  end;
+	  while Exp^.Prev<>FinalPointer do
+		Exp:=Exp^.Prev;
+	  Result:=Exp^.Handler;
+	end;
+	
+	procedure Setup_FinalExceptHandler(var buf:TExceptionRegister);assembler;nostackframe;
+    asm
+	  movl %eax,%fs:(0)
+	end;
+{$endif}
 
 {*****************************************************************************
                             Thread starting
@@ -205,6 +234,9 @@
 
     function ThreadMain(param : pointer) : Longint; {$ifdef wince}cdecl{$else}stdcall{$endif};
       var
+	    {$ifdef win32_seh}
+	    fakeExcept:TExceptionRegister;
+		{$endif}
         ti : tthreadinfo;
       begin
         { Copy parameter to local data }
@@ -220,6 +252,13 @@
           InitThread(ti.stklen);
 
         dispose(pthreadinfo(param));
+		
+		{$ifdef win32_seh}
+		{ install fake handler for SEHOP }
+		fakeExcept.Handler:=Get_FinalExceptionHandler;
+		fakeExcept.prev:=FinalPointer;
+		Setup_FinalExceptHandler(fakeExcept);
+		{$endif}
 
         { Start thread function }
 {$ifdef DEBUG_MT}

Do-wan Kim

2013-11-26 16:45

reporter   ~0071617

@Andrey
make fake handler for thread, but I don't know it did work.

@Sven
I need more time to understand about native SEH xD

Do-wan Kim

2013-11-27 06:15

reporter   ~0071636

Last thread patch is ignore. Thread install system exception handler at start,not need install fake handler. If fiber it will be need at initializarion.

Sven Barth

2013-11-27 06:36

manager   ~0071637

Your SEHOP is wrong. You need to check whether ntdll.dll exports FinalExceptionHandler (AFAIK it exists only since Vista) using LoadLibrary and GetProcAddress and then you need to set this as outermost handler of ThreadMain and ExeEntry.

And yes, take your time to get known to SEH :)

Regards,
Sven

Andrey Paramonov

2013-11-27 08:02

reporter   ~0071638

I'm not really sure that additional code is needed to support SEHOP if SEH is implemented properly. AFAIK both CreateThread and CreateFiber do correctly install FinalExceptionHandler. So special care should only be taken regarding EXCEPTION_REGISTRATION_RECORD allocation (on the stack).

My point is that SEHOP is a fact nowdays, so the implementation must be checked to actually work under SEHOP. Most likely it will just work, but who knows :-)

Do-wan Kim

2013-11-27 10:11

reporter   ~0071639

Yep, it's wrong. but it has already pointing finalexception handler in linked list? it's maybe a trick. but not necessary to process and thread. D runtime initialize with this way and not problem at all xD

https://github.com/D-Programming-Language/druntime/blob/c39de42dd11311844c0ef90953aa65f333ea55ab/src/core/thread.d#L4027

It's maybe fiber only problem. After creation fiber do something like last code. There is no error in my windows 7 test with thread.

More enhancing implemenation SEH is difficult, it's out of my system programming ability T_T

Sven Barth

2013-11-27 11:03

manager   ~0071641

@Andrey: yes, it should indeed work correctly without any modifications in ThreadMain as long as the pushing of the new exception frame uses the previous installed handler.

@Do-wan Kim: it's never too late to improve ones abilities ;)

Regards,
Sven

Do-wan Kim

2013-11-28 08:38

reporter   ~0071668

Last edited: 2013-11-28 08:43

View 2 revisions

with some web document, rtlunwind at win32 is not good option. for under windows 98 compatiblity, not full native seh is good I guess.

There is interesting document at cygwin and windows 2008.It describe what "rtlunwind" exactly doing xD

http://www.archivum.info/microsoft.public.win32.programmer.kernel/2008-02/00097/Re-Frame-based-exception-handling-problem-on-Server-2008.html

ftp://ftp.zedz.net/pub/security/info/textfiles/natural-selection/ns-001/ns%231-2_6.txt

Maybe win64 is more fully support SEH, but not win32.
If fully support native win32 SEH, it changes stack-related code-gen part also :0

Do-wan Kim

2013-11-28 08:40

reporter  

win32_seh_perthread_final_n386flw.patch (44,984 bytes)   
Index: compiler/i386/cpunode.pas
===================================================================
--- compiler/i386/cpunode.pas	(revision 26150)
+++ compiler/i386/cpunode.pas	(working copy)
@@ -55,6 +55,9 @@
        n386set,
        n386inl,
        n386mat
+{$ifdef win32_seh}
+      , n386flw
+{$endif}
        ;
 
 end.
Index: compiler/i386/n386flw.pas
===================================================================
--- compiler/i386/n386flw.pas	(revision 0)
+++ compiler/i386/n386flw.pas	(working copy)
@@ -0,0 +1,793 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate assembler for nodes that influence the flow which are
+    the same for all (most?) processors
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit n386flw;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      aasmbase,node,nflw,ncgutil,ncgflw;
+
+    type
+	
+       tcg386tryexceptnode = class(tcgtryexceptnode)
+          procedure pass_generate_code;override;
+       end;
+
+       tcg386tryfinallynode = class(tcgtryfinallynode)
+          procedure handle_safecall_exception;
+          procedure pass_generate_code;override;
+       end;
+
+       tcg386onnode = class(tcgonnode)
+          procedure pass_generate_code;override;
+       end;
+
+implementation
+
+    uses
+      verbose,globals,systems,globtype,constexp,
+      symconst,symdef,symsym,symtable,aasmtai,aasmdata,aasmcpu,defutil,
+      procinfo,cgbase,pass_2,parabase,
+      cpubase,ncon,
+      tgobj,paramgr,
+      cgutils,cgobj,hlcgobj,nutils
+      ;
+
+
+{*****************************************************************************
+                             SecondTryExcept
+*****************************************************************************}
+
+    var
+       endexceptlabel : tasmlabel;
+
+    procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
+      const
+{$ifdef cpu16bitaddr}
+        pushexceptaddr_frametype_cgsize = OS_S16;
+        setjmp_result_cgsize = OS_S16;
+{$else cpu16bitaddr}
+        pushexceptaddr_frametype_cgsize = OS_S32;
+        setjmp_result_cgsize = OS_S32;
+{$endif cpu16bitaddr}
+      var
+        paraloc1,paraloc2,paraloc3 : tcgpara;
+        pd: tprocdef;
+      begin
+        pd:=search_system_proc('fpc_pushexceptaddr');		
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+        paramanager.getintparaloc(pd,1,paraloc1);
+        paramanager.getintparaloc(pd,2,paraloc2);
+        paramanager.getintparaloc(pd,3,paraloc3);
+        if pd.is_pushleftright then
+          begin
+            { push type of exceptionframe }
+            cg.a_load_const_cgpara(list,pushexceptaddr_frametype_cgsize,1,paraloc1);
+            cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
+            cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
+          end
+        else
+          begin
+            cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
+            cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
+            { push type of exceptionframe }
+            cg.a_load_const_cgpara(list,pushexceptaddr_frametype_cgsize,1,paraloc1);
+          end;
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);		
+        cg.deallocallcpuregisters(list);
+		
+		{ save fs:(0) and setup exception handling, return jmpbuf }		
+        pd:=search_system_proc('fpc_pushwinseh');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_PUSHWINSEH',false);
+        cg.deallocallcpuregisters(list);		
+		
+        pd:=search_system_proc('fpc_setjmp');
+        paramanager.getintparaloc(pd,1,paraloc1);
+        cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        cg.allocallcpuregisters(list);
+        cg.a_call_name(list,'FPC_SETJMP',false);
+        cg.deallocallcpuregisters(list);
+        cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
+
+        cg.g_exception_reason_save(list, t.reasonbuf);
+        cg.a_cmp_const_reg_label(list,setjmp_result_cgsize,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,setjmp_result_cgsize),exceptlabel);
+        cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
+        paraloc1.done;
+        paraloc2.done;
+        paraloc3.done;
+     end;
+
+     procedure pop_addrstack(list:TAsmList;const t:texceptiontemps);
+	   var
+         paraloc1 : tcgpara;
+         pd: tprocdef;
+	 begin
+	   paraloc1.init;
+	   pd:=search_system_proc('fpc_popaddrstackseh');
+	   paramanager.getintparaloc(pd,1,paraloc1);
+	   cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc1);
+	   paramanager.freecgpara(list,paraloc1);
+	   cg.g_call(list,'FPC_POPADDRSTACKSEH');	  
+	   paraloc1.done;
+	 end;
+
+
+     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+     begin
+	     { free exception handler and restore prev value }
+		 pop_addrstack(list,t);
+
+         if not onlyfree then
+          begin
+            { g_exception_reason_load already allocates NR_FUNCTION_RESULT_REG }
+            cg.g_exception_reason_load(list, t.reasonbuf);
+            cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel);
+            cg.a_reg_dealloc(list,NR_FUNCTION_RESULT_REG);
+          end;
+     end;	
+
+    { does the necessary things to clean up the object stack }
+    { in the except block                                    }
+    procedure cleanupobjectstack;
+      begin
+         cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+      end;
+
+    { generates code to be executed when another exeception is raised while
+      control is inside except block }
+    procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;entrylabel:TAsmLabel);
+      var
+         exitlabel: tasmlabel;
+      begin
+         { don't generate line info for internal cleanup }
+         list.concat(tai_marker.create(mark_NoLineInfoStart));
+         current_asmdata.getjumplabel(exitlabel);
+         cg.a_label(list,entrylabel);
+         free_exception(list,t,0,exitlabel,false);
+         { we don't need to save/restore registers here because reraise never }
+         { returns                                                            }
+         cg.a_call_name(list,'FPC_RAISE_NESTED',false);
+         cg.a_label(list,exitlabel);
+         cleanupobjectstack;
+      end;
+
+
+    procedure tcg386tryexceptnode.pass_generate_code;
+
+      var
+         exceptlabel,doexceptlabel,oldendexceptlabel,
+         lastonlabel,
+         exitexceptlabel,
+         continueexceptlabel,
+         breakexceptlabel,
+         exittrylabel,
+         continuetrylabel,
+         breaktrylabel,
+         doobjectdestroyandreraise,
+         oldCurrExitLabel,
+         oldContinueLabel,
+         oldBreakLabel : tasmlabel;
+         oldflowcontrol,tryflowcontrol,
+         exceptflowcontrol : tflowcontrol;
+         destroytemps,
+         excepttemps : texceptiontemps;
+      label
+         errorexit;
+      begin
+		 if (target_info.system<>system_i386_win32) then
+		   begin
+			 inherited pass_generate_code;
+			 exit;
+		   end;	  
+         location_reset(location,LOC_VOID,OS_NO);
+
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         { this can be called recursivly }
+         oldBreakLabel:=nil;
+         oldContinueLabel:=nil;
+         oldendexceptlabel:=endexceptlabel;
+
+         { save the old labels for control flow statements }
+         oldCurrExitLabel:=current_procinfo.CurrExitLabel;
+         if assigned(current_procinfo.CurrBreakLabel) then
+           begin
+              oldContinueLabel:=current_procinfo.CurrContinueLabel;
+              oldBreakLabel:=current_procinfo.CurrBreakLabel;
+           end;
+
+         { get new labels for the control flow statements }
+         current_asmdata.getjumplabel(exittrylabel);
+         current_asmdata.getjumplabel(exitexceptlabel);
+         if assigned(current_procinfo.CurrBreakLabel) then
+           begin
+              current_asmdata.getjumplabel(breaktrylabel);
+              current_asmdata.getjumplabel(continuetrylabel);
+              current_asmdata.getjumplabel(breakexceptlabel);
+              current_asmdata.getjumplabel(continueexceptlabel);
+           end;
+
+         current_asmdata.getjumplabel(exceptlabel);
+         current_asmdata.getjumplabel(doexceptlabel);
+         current_asmdata.getjumplabel(endexceptlabel);
+         current_asmdata.getjumplabel(lastonlabel);
+
+         get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         new_exception(current_asmdata.CurrAsmList,excepttemps,exceptlabel);
+
+         { try block }
+         { set control flow labels for the try block }
+         current_procinfo.CurrExitLabel:=exittrylabel;
+         if assigned(oldBreakLabel) then
+          begin
+            current_procinfo.CurrContinueLabel:=continuetrylabel;
+            current_procinfo.CurrBreakLabel:=breaktrylabel;
+          end;
+
+         flowcontrol:=[fc_inflowcontrol];
+         secondpass(left);
+         tryflowcontrol:=flowcontrol;
+         if codegenerror then
+           goto errorexit;
+
+         { don't generate line info for internal cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+         cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
+
+         free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false);
+
+         cg.a_label(current_asmdata.CurrAsmList,doexceptlabel);
+
+         { end cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         { set control flow labels for the except block }
+         { and the on statements                        }
+         current_procinfo.CurrExitLabel:=exitexceptlabel;
+         if assigned(oldBreakLabel) then
+          begin
+            current_procinfo.CurrContinueLabel:=continueexceptlabel;
+            current_procinfo.CurrBreakLabel:=breakexceptlabel;
+          end;
+
+         flowcontrol:=[fc_inflowcontrol];
+         { on statements }
+         if assigned(right) then
+           secondpass(right);
+
+         { don't generate line info for internal cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+         cg.a_label(current_asmdata.CurrAsmList,lastonlabel);
+         { default handling except handling }
+         if assigned(t1) then
+           begin
+              { FPC_CATCHES with 'default handler' flag (=-1) need no longer be called,
+                it doesn't change any state and its return value is ignored (Sergei)
+              }
+
+              { the destruction of the exception object must be also }
+              { guarded by an exception frame, but it can be omitted }
+              { if there's no user code in 'except' block            }
+
+              if not (has_no_code(t1)) then
+               begin
+                 current_asmdata.getjumplabel(doobjectdestroyandreraise);
+
+                 get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
+
+                 { except block needs line info }
+                 current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+                 { here we don't have to reset flowcontrol           }
+                 { the default and on flowcontrols are handled equal }
+                 secondpass(t1);
+                 exceptflowcontrol:=flowcontrol;
+
+                 handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
+
+                 unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+               end
+               else
+                 begin
+                   exceptflowcontrol:=flowcontrol;
+                   cleanupobjectstack;
+                   cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+                 end;
+           end
+         else
+           begin
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+              exceptflowcontrol:=flowcontrol;
+           end;
+
+         if fc_exit in exceptflowcontrol then
+           begin
+              { do some magic for exit in the try block }
+              cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
+              { we must also destroy the address frame which guards }
+              { exception object                                    }
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);			  
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cleanupobjectstack;
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+
+         if fc_break in exceptflowcontrol then
+           begin
+              cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
+              { we must also destroy the address frame which guards }
+              { exception object                                    }
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cleanupobjectstack;
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+
+         if fc_continue in exceptflowcontrol then
+           begin
+              cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
+              { we must also destroy the address frame which guards }
+              { exception object                                    }
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cleanupobjectstack;
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+
+         if fc_exit in tryflowcontrol then
+           begin
+              { do some magic for exit in the try block }
+              cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+
+         if fc_break in tryflowcontrol then
+           begin
+              cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+
+         if fc_continue in tryflowcontrol then
+           begin
+              cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
+              pop_addrstack(current_asmdata.CurrAsmList,excepttemps);
+              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+              { from g_exception_reason_load  }
+              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+           end;
+         unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         cg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
+
+         { end cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+       errorexit:
+         { restore all saved labels }
+         endexceptlabel:=oldendexceptlabel;
+
+         { restore the control flow labels }
+         current_procinfo.CurrExitLabel:=oldCurrExitLabel;
+         if assigned(oldBreakLabel) then
+          begin
+            current_procinfo.CurrContinueLabel:=oldContinueLabel;
+            current_procinfo.CurrBreakLabel:=oldBreakLabel;
+          end;
+
+         { return all used control flow statements }
+         flowcontrol:=oldflowcontrol+(exceptflowcontrol +
+           tryflowcontrol - [fc_inflowcontrol]);
+      end;
+
+
+    procedure tcg386onnode.pass_generate_code;
+      var
+         nextonlabel,
+         exitonlabel,
+         continueonlabel,
+         breakonlabel,
+         oldCurrExitLabel,
+         oldContinueLabel,
+         doobjectdestroyandreraise,
+         oldBreakLabel : tasmlabel;
+         oldflowcontrol : tflowcontrol;
+         excepttemps : texceptiontemps;
+         href2: treference;
+         paraloc1 : tcgpara;
+         exceptvarsym : tlocalvarsym;
+         pd : tprocdef;
+      begin
+		 if (target_info.system<>system_i386_win32) then
+		   begin
+			 inherited pass_generate_code;
+			 exit;
+		   end;	  	  
+         paraloc1.init;
+         location_reset(location,LOC_VOID,OS_NO);
+
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         current_asmdata.getjumplabel(nextonlabel);
+
+         { send the vmt parameter }
+         pd:=search_system_proc('fpc_catches');
+         reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname,AT_DATA),0,sizeof(pint));
+         paramanager.getintparaloc(pd,1,paraloc1);
+         cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc1);
+         paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
+         cg.g_call(current_asmdata.CurrAsmList,'FPC_CATCHES');
+
+         cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+         { is it this catch? No. go to next onlabel }
+         cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,NR_FUNCTION_RESULT_REG,nextonlabel);
+
+         { Retrieve exception variable }
+         if assigned(excepTSymtable) then
+           exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
+         else
+           internalerror(2011020401);
+
+         if assigned(exceptvarsym) then
+           begin
+             location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,OS_ADDR,sizeof(pint));
+             tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference);
+             cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference);
+           end;
+         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+
+         { in the case that another exception is risen
+           we've to destroy the old one                }
+         current_asmdata.getjumplabel(doobjectdestroyandreraise);
+
+         { call setjmp, and jump to finally label on non-zero result }
+         get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         new_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraise);
+
+         oldBreakLabel:=nil;
+         oldContinueLabel:=nil;
+         if assigned(right) then
+           begin
+              oldCurrExitLabel:=current_procinfo.CurrExitLabel;
+              current_asmdata.getjumplabel(exitonlabel);
+              current_procinfo.CurrExitLabel:=exitonlabel;
+              if assigned(current_procinfo.CurrBreakLabel) then
+               begin
+                 oldContinueLabel:=current_procinfo.CurrContinueLabel;
+                 oldBreakLabel:=current_procinfo.CurrBreakLabel;
+                 current_asmdata.getjumplabel(breakonlabel);
+                 current_asmdata.getjumplabel(continueonlabel);
+                 current_procinfo.CurrContinueLabel:=continueonlabel;
+                 current_procinfo.CurrBreakLabel:=breakonlabel;
+               end;
+
+              secondpass(right);
+           end;
+
+         handle_nested_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraise);
+
+         { clear some stuff }
+         if assigned(exceptvarsym) then
+           begin
+             tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
+             exceptvarsym.localloc.loc:=LOC_INVALID;
+           end;
+         cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+
+         if assigned(right) then
+           begin
+              { special handling for control flow instructions }
+              if fc_exit in flowcontrol then
+                begin
+                   { the address and object pop does secondtryexcept }
+                   cg.a_label(current_asmdata.CurrAsmList,exitonlabel);
+                   cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+                end;
+
+              if fc_break in flowcontrol then
+                begin
+                   { the address and object pop does secondtryexcept }
+                   cg.a_label(current_asmdata.CurrAsmList,breakonlabel);
+                   cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+                end;
+
+              if fc_continue in flowcontrol then
+                begin
+                   { the address and object pop does secondtryexcept }
+                   cg.a_label(current_asmdata.CurrAsmList,continueonlabel);
+                   cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+                end;
+
+              current_procinfo.CurrExitLabel:=oldCurrExitLabel;
+              if assigned(oldBreakLabel) then
+               begin
+                 current_procinfo.CurrContinueLabel:=oldContinueLabel;
+                 current_procinfo.CurrBreakLabel:=oldBreakLabel;
+               end;
+           end;
+
+         unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         cg.a_label(current_asmdata.CurrAsmList,nextonlabel);
+         flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]);
+         paraloc1.done;
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         { next on node }
+         if assigned(left) then
+           secondpass(left);
+      end;
+
+{*****************************************************************************
+                             SecondTryFinally
+*****************************************************************************}
+
+    procedure tcg386tryfinallynode.handle_safecall_exception;
+      var
+        cgpara: tcgpara;
+        selfsym: tparavarsym;
+        pd: tprocdef;
+      begin
+        { call fpc_safecallhandler, passing self for methods of classes,
+          nil otherwise. }
+        pd:=search_system_proc('fpc_safecallhandler');
+        cgpara.init;
+        paramanager.getintparaloc(pd,1,cgpara);
+        if is_class(current_procinfo.procdef.struct) then
+          begin
+            selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));
+            if (selfsym=nil) or (selfsym.typ<>paravarsym) then
+              InternalError(2011123101);
+            cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.localloc,cgpara);
+          end
+        else
+          cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,cgpara);
+        paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
+        cgpara.done;
+        cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLHANDLER');
+        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG);
+      end;
+
+    procedure tcg386tryfinallynode.pass_generate_code;
+      var
+         reraiselabel,
+         finallylabel,
+         endfinallylabel,
+         exitfinallylabel,
+         continuefinallylabel,
+         breakfinallylabel,
+         oldCurrExitLabel,
+         oldContinueLabel,
+         oldBreakLabel : tasmlabel;
+         oldflowcontrol,tryflowcontrol : tflowcontrol;
+         decconst : longint;
+         excepttemps : texceptiontemps;
+      begin
+		 if (target_info.system<>system_i386_win32) then
+		   begin
+			 inherited pass_generate_code;
+			 exit;
+		   end;	  	  
+         location_reset(location,LOC_VOID,OS_NO);
+
+         { check if child nodes do a break/continue/exit }
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         current_asmdata.getjumplabel(finallylabel);
+         current_asmdata.getjumplabel(endfinallylabel);
+         current_asmdata.getjumplabel(reraiselabel);
+
+         { the finally block must catch break, continue and exit }
+         { statements                                            }
+         oldCurrExitLabel:=current_procinfo.CurrExitLabel;
+         if implicitframe then
+           exitfinallylabel:=finallylabel
+         else
+           current_asmdata.getjumplabel(exitfinallylabel);
+         current_procinfo.CurrExitLabel:=exitfinallylabel;
+         if assigned(current_procinfo.CurrBreakLabel) then
+          begin
+            oldContinueLabel:=current_procinfo.CurrContinueLabel;
+            oldBreakLabel:=current_procinfo.CurrBreakLabel;
+            if implicitframe then
+              begin
+                breakfinallylabel:=finallylabel;
+                continuefinallylabel:=finallylabel;
+              end
+            else
+              begin
+                current_asmdata.getjumplabel(breakfinallylabel);
+                current_asmdata.getjumplabel(continuefinallylabel);
+              end;
+            current_procinfo.CurrContinueLabel:=continuefinallylabel;
+            current_procinfo.CurrBreakLabel:=breakfinallylabel;
+          end;
+
+         { call setjmp, and jump to finally label on non-zero result }
+         get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         new_exception(current_asmdata.CurrAsmList,excepttemps,finallylabel);
+
+         { try code }
+         if assigned(left) then
+           begin
+              secondpass(left);
+              tryflowcontrol:=flowcontrol;
+              if codegenerror then
+                exit;
+           end;
+
+         { don't generate line info for internal cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+         cg.a_label(current_asmdata.CurrAsmList,finallylabel);
+         { just free the frame information }
+         free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallylabel,true);
+
+         { end cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         { finally code }
+         flowcontrol:=[fc_inflowcontrol];
+         secondpass(right);
+         { goto is allowed if it stays inside the finally block,
+           this is checked using the exception block number }
+         if (flowcontrol-[fc_gotolabel])<>[fc_inflowcontrol] then
+           CGMessage(cg_e_control_flow_outside_finally);
+         if codegenerror then
+           exit;
+
+         { don't generate line info for internal cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+         { the value should now be in the exception handler }
+         cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+         if implicitframe then
+           begin
+             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel);
+             { from g_exception_reason_load  }
+             cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+             { finally code only needed to be executed on exception }
+             flowcontrol:=[fc_inflowcontrol];
+             secondpass(t1);
+             if flowcontrol<>[fc_inflowcontrol] then
+               CGMessage(cg_e_control_flow_outside_finally);
+             if codegenerror then
+               exit;
+             if (tf_safecall_exceptions in target_info.flags) and
+                (current_procinfo.procdef.proccalloption=pocall_safecall) then
+               handle_safecall_exception
+             else
+                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+           end
+         else
+           begin
+             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel);
+             if (tryflowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then
+               begin
+                 cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
+                 cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,reraiselabel);
+                 if fc_exit in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldCurrExitLabel);
+                     decconst:=1;
+                   end
+                 else
+                   decconst:=2;
+                 if fc_break in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldBreakLabel);
+                     decconst:=1;
+                   end
+                 else
+                   inc(decconst);
+                 if fc_continue in tryflowcontrol then
+                   begin
+                     cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG);
+                     cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel);
+                   end;
+               end;
+             cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+             cg.a_label(current_asmdata.CurrAsmList,reraiselabel);
+             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+             { do some magic for exit,break,continue in the try block }
+             if fc_exit in tryflowcontrol then
+               begin
+                  cg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
+                  cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+                  cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,2);
+                  cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+                  { from g_exception_reason_load  }
+                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+               end;
+             if fc_break in tryflowcontrol then
+              begin
+                 cg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
+                 cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+                 cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,3);
+                 cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+                  { from g_exception_reason_load  }
+                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+               end;
+             if fc_continue in tryflowcontrol then
+               begin
+                  cg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
+                  cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+                  cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,4);
+                  cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+                  { from g_exception_reason_load  }
+                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+               end;
+           end;
+         unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+         cg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
+
+         { end cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         current_procinfo.CurrExitLabel:=oldCurrExitLabel;
+         if assigned(current_procinfo.CurrBreakLabel) then
+          begin
+            current_procinfo.CurrContinueLabel:=oldContinueLabel;
+            current_procinfo.CurrBreakLabel:=oldBreakLabel;
+          end;
+         flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
+      end;
+
+
+begin
+   ctryexceptnode:=tcg386tryexceptnode;
+   ctryfinallynode:=tcg386tryfinallynode;
+   connode:=tcg386onnode;
+end.
+
Index: rtl/i386/setjumph.inc
===================================================================
--- rtl/i386/setjumph.inc	(revision 26150)
+++ rtl/i386/setjumph.inc	(working copy)
@@ -15,6 +15,16 @@
 
 Type
   jmp_buf = packed record
+	{$ifdef win32}
+	{$ifdef win32_seh}
+	{ fs:(0) stored here. compiler reserves stack, you cannot walk with push/pop on a stack. 
+      RTLUnwind stop at this frame. lower position at stack for futher use and 
+	  protect jmp_buf from RTLUnwind. Currently not using RTLUnwind.
+	  It just prepare.
+	}	
+	fs, Handler : Pointer;
+	{$endif}
+	{$endif}  
     ebx,esi,edi : Longint;
     bp,sp,pc : Pointer;
     end;
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 26150)
+++ rtl/inc/compproc.inc	(working copy)
@@ -604,6 +604,13 @@
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
 procedure fpc_doneexception; compilerproc;
 procedure fpc_raise_nested; compilerproc;
+{ New functions for win32 seh }
+{$ifdef win32}
+  {$ifdef win32_seh}
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf); compilerproc;
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer; compilerproc;
+  {$endif}
+{$endif}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
Index: rtl/inc/except.inc
===================================================================
--- rtl/inc/except.inc	(revision 26150)
+++ rtl/inc/except.inc	(working copy)
@@ -48,6 +48,13 @@
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
   ExceptTryLevel    : longint;
+  { for out of range stackframe checking. }
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip    : PExceptAddr;
+  SkipAddrCount     : Integer;
+  {$endif}  
+  {$endif}
 
 Function RaiseList : PExceptObject;
 begin
@@ -84,7 +91,125 @@
     RunError(231);
 end;
 
+{$ifdef win32}
+{$ifdef win32_seh}
+ 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;
+
+{ save fs:(0) and setup Handler. AStackFrame:PExceptAddr }
+Function fpc_PushWinSEH(AStackFrame:Pointer):Pointer;assembler;nostackframe;[Public, Alias : 'FPC_PUSHWINSEH'];compilerproc;
+asm
+  movl (%eax),%eax        // Get Jmp_buf, ExceptAddr^.buf
+  movl $thread_exception_handler,Jmp_buf.Handler(%eax) // per thread handler
+  movl %fs:(0),%edx     
+  movl %edx,Jmp_buf.fs(%eax)  // get and save handler
+  leal Jmp_buf.fs(%eax),%edx
+  movl %edx,%fs:(0)     // assign new handler
+end;
+
+
+{ restore handler, it must be difference with fpc_popaddrstack.
+  it's only work on free_exceptionhandler. }
+Procedure fpc_PopAddrStackSeh(var buf:Jmp_buf);[Public, Alias : 'FPC_POPADDRSTACKSEH']; compilerproc;
+label skip_fs_load;
+var
+  hp : ^PExceptAddr;
+  prev,curr : PExceptAddr;
+  cstack, TopStack : PtrUInt;
+begin
+{$ifdef excdebug}
+  writeln ('In Popaddrstack');
+{$endif}
+  { restore from current buf at stack
+   linked list sometimes got bad value (with fiber) }
+  asm
+    pushl %eax
+    movl buf,%eax
+	testl %eax,%eax
+	jz skip_fs_load
+	movl Jmp_buf.fs(%eax),%eax
+	movl %eax,%fs:(0)
+skip_fs_load:	
+	popl %eax
+  end;
+  hp:=@ExceptAddrStack;
+  If hp^=nil then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionAddresStack');
+{$endif}
+      halt (255);
+    end
+  else
+    begin
+	  { get stack information }
+	  asm 
+	    mov %ebp,cstack
+		mov %fs:(4),%eax
+		mov %eax,TopStack
+	  end;
+	  { free previous skipped out of stack exceptframe. }
+	  if (ExceptAddrSkip<>nil) then
+	  if (PtrUInt(ExceptAddrSkip)<TopStack) and (PtrUInt(ExceptAddrSkip)>cstack) then
+	  begin
+	    ExceptAddrSkip:=nil;
+		{ Is bad stack frame on same ranges? I don't know. }
+		while SkipAddrCount>0 do begin
+		  hp^:=hp^^.Next;
+		  Dec(SkipAddrCount);
+		  if hp^=nil then
+		    break;
+		end;
+	  end;
+	  { start except stack checking }
+	  prev:=hp^;	  
+	  curr:=prev;
+	  while curr<>nil do
+	  begin
+	    { check valid range of stack }
+	    if (PtrUInt(curr)<TopStack) and (PtrUInt(curr)>cstack) then
+		begin
+		  { get prev value and break }
+		  if curr=prev then
+		    hp^:=hp^^.Next
+			else
+			  prev^.Next:=curr^.Next;
+		  break;
+		end else begin
+		  { most out of stack value above range like thread, skip it }
+		  if PtrUInt(curr)>TopStack then
+		  begin
+		    if ExceptAddrSkip=nil then
+			begin
+		      ExceptAddrSkip:=curr;
+			  SkipAddrCount:=1;
+			end else
+			  Inc(SkipAddrCount);
+		    break;
+		  end;
+		  prev:=curr;
+		  curr:=curr^.Next;
+		end;
+	  end;	
+    end;
+end;
+
+{$endif} //win32_seh
+{$endif} //win32
+
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];compilerproc;
 var
@@ -394,6 +519,11 @@
 begin
   ExceptObjectstack:=Nil;
   ExceptAddrStack:=Nil;
+  {$ifdef win32}
+  {$ifdef win32_seh}
+  ExceptAddrSkip:=Nil;
+  {$endif}  
+  {$endif}
 end;
 
 
Index: rtl/win32/system.pp
===================================================================
--- rtl/win32/system.pp	(revision 26150)
+++ rtl/win32/system.pp	(working copy)
@@ -409,6 +409,8 @@
     end;
   end;
 
+{$ifndef win32_seh}
+// final exception handler
 function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
   var
     res: longint;
@@ -513,7 +515,110 @@
     end;
     syswin32_i386_exception_handler := res;
   end;
+  
+{$else} // win32_seh
+// per thread exception handler
+  function thread_exception_handler(ExceptRecord:_PEXCEPTION_RECORD;Frame:Pointer;Context:Pointer;dispatcher:Pointer):longint; cdecl;
+  var
+    res: longint;
+    err: byte;
+    must_reset_fpu: boolean;
+  begin
+    // is non-continuable exception? , return 1;
+    if (ExceptRecord^.ExceptionFlags and 1)=0 then begin
+    //if PContext(Context)^.SegSs=_SS then begin // not work ;D
+      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(PContext(Context)^.eip,3);
+              ExceptRecord^.ExceptionCode := 0;
+              res:=EXCEPTION_CONTINUE_EXECUTION;
+            end
+          else
+            err := 216;
+        STATUS_ACCESS_VIOLATION:
+          { Athlon prefetch bug? }
+          if is_prefetch(Pointer(PContext(Context)^.eip)) 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) and (exceptLevel < MaxExceptionLevel) then begin
+        exceptEip[exceptLevel] := PContext(Context)^.eip;
+        exceptError[exceptLevel] := err;
+        resetFPU[exceptLevel] := must_reset_fpu;
+        inc(exceptLevel);
+
+		
+        ExceptRecord^.ExceptionCode := 0;
+        res := EXCEPTION_CONTINUE_EXECUTION;
+		PContext(Context)^.eip:=DWORD(@JumpToHandleErrorFrame);
+		//PContext(Context)^.ebp:=PDWORD(Frame+$8)^;
+
+      end;
+	//end; // check _SS
+	
+	// continue execution, return 0;
+	if res=EXCEPTION_CONTINUE_EXECUTION then
+	  Result:=0
+	  else
+	    Result:=1;
+    end else
+      Result:=1;
+  end;
+{$endif}
+
 procedure install_exception_handlers;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
   var
@@ -529,7 +634,9 @@
       movl %eax,oldexceptaddr
     end;
 {$endif SYSTEMEXCEPTIONDEBUG}
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+	{$endif}
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     asm
       movl $0,%eax
@@ -544,7 +651,9 @@
 
 procedure remove_exception_handlers;
   begin
+    {$ifndef win32_seh}
     SetUnhandledExceptionFilter(nil);
+	{$endif}
   end;
 
 {$else not cpui386 (Processor specific !!)}

Sven Barth

2013-11-28 09:23

manager   ~0071669

Windows 98 support is no problem, because we don't officially support 9x anymore. For those that still need it we can leave a "NO_SEH32" define for the compiler which would use the previous platform independant exception mechanism.

Also we will use RtlUnwind, because this is the officially supported way how the stack is unwind until the specified exception frame. Microsoft and ReactOS use it as well. Also we are implementing a compiler and RTL so we can implement its usage correctly (unlike Cygwin for example).

Regards,
Sven

Sergei Gorelkin

2013-11-28 10:22

developer   ~0071672

AFAIK OS part of exception handling in Win32 has not changed since first Win9x (except introducing security features like SEHOP). Old Delphi programs which run in Win98 definitely use RtlUnwind.

And yes, codegeneration outside of flow nodes needs changing, at least tcg386 likely must override g_local_unwind method and g_proc_entry needs to support custom prologues for procedures of type potype_exceptfilter.

Do-wan Kim

2013-11-28 14:18

reporter   ~0071678

Testing RTLUnwind, it only change FS:[0] to stored in destination frame and nothing changed. EBP, ESP, EIP must manually set after call rtlunwind. And return address parameter ignored.

Sergei Gorelkin

2013-11-28 14:37

developer   ~0071679

RtlUnwind calls exception handlers that are installed between topmost frame and the target one. The overall result depends on code of exception handlers (in the simplest case, nothing changes indeed). However RtlUnwind on Win32 is indeed different from Win64, where it also completely restores processor context (excluding value of RAX register).

Sergei Gorelkin

2013-12-12 14:02

developer   ~0071877

This patch cannot be applied due to issues indicated above.

However, I wrote SEH support for Win32 based on my Win64 experience and committed it in r26225. To enable, cycle the compiler with OPT=-dTEST_WIN32_SEH.
After solving some remaining issues, which are indicated in commit message, it will become enabled by default.

Do-wan Kim

2013-12-16 08:37

reporter   ~0071914

Thank you. It works fine :)

Issue History

Date Modified Username Field Change
2013-11-24 10:38 Do-wan Kim New Issue
2013-11-24 10:38 Do-wan Kim File Added: win32_seh_per_thread.patch
2013-11-24 10:40 Do-wan Kim File Added: dlltest_new_patch.zip
2013-11-24 10:42 Do-wan Kim Note Added: 0071528
2013-11-24 13:00 Do-wan Kim File Added: win32_seh_per_thread_and_list.patch
2013-11-24 13:51 Jonas Maebe Relationship added related to 0012974
2013-11-24 13:51 Jonas Maebe Relationship added related to 0025312
2013-11-24 18:41 Sven Barth Note Added: 0071553
2013-11-25 03:54 Do-wan Kim Note Added: 0071569
2013-11-25 03:54 Do-wan Kim File Added: win32_seh_per_thread_and_list_new.patch
2013-11-25 05:03 Do-wan Kim File Added: win32_seh_per_thread_and_list_newfix.patch
2013-11-25 10:49 Do-wan Kim File Added: win32_seh_perthread_final.patch
2013-11-25 10:55 Do-wan Kim Note Added: 0071573
2013-11-25 10:56 Do-wan Kim Note Edited: 0071573 View Revisions
2013-11-25 11:19 Do-wan Kim File Added: win32_seh_perthread_final_0.patch
2013-11-25 16:10 Sven Barth Note Added: 0071588
2013-11-26 02:06 Do-wan Kim File Added: win32seh.zip
2013-11-26 02:12 Do-wan Kim Note Added: 0071599
2013-11-26 07:56 Sven Barth Note Added: 0071604
2013-11-26 10:16 Do-wan Kim Note Added: 0071609
2013-11-26 11:44 Andrey Paramonov Note Added: 0071610
2013-11-26 12:19 Sven Barth Note Added: 0071612
2013-11-26 12:46 Sven Barth Note Added: 0071613
2013-11-26 14:42 Do-wan Kim Note Added: 0071615
2013-11-26 14:50 Sven Barth Note Added: 0071616
2013-11-26 16:38 Do-wan Kim File Added: win32_seh_perthread_final_sehop.patch
2013-11-26 16:45 Do-wan Kim Note Added: 0071617
2013-11-27 06:15 Do-wan Kim Note Added: 0071636
2013-11-27 06:36 Sven Barth Note Added: 0071637
2013-11-27 08:02 Andrey Paramonov Note Added: 0071638
2013-11-27 10:11 Do-wan Kim Note Added: 0071639
2013-11-27 11:03 Sven Barth Note Added: 0071641
2013-11-28 08:38 Do-wan Kim Note Added: 0071668
2013-11-28 08:40 Do-wan Kim File Added: win32_seh_perthread_final_n386flw.patch
2013-11-28 08:43 Do-wan Kim Note Edited: 0071668 View Revisions
2013-11-28 09:23 Sven Barth Note Added: 0071669
2013-11-28 10:22 Sergei Gorelkin Note Added: 0071672
2013-11-28 14:18 Do-wan Kim Note Added: 0071678
2013-11-28 14:37 Sergei Gorelkin Note Added: 0071679
2013-12-12 14:02 Sergei Gorelkin Note Added: 0071877
2013-12-12 14:03 Sergei Gorelkin Fixed in Revision => 26225
2013-12-12 14:03 Sergei Gorelkin Status new => resolved
2013-12-12 14:03 Sergei Gorelkin Fixed in Version => 2.7.1
2013-12-12 14:03 Sergei Gorelkin Resolution open => fixed
2013-12-12 14:03 Sergei Gorelkin Assigned To => Sergei Gorelkin
2013-12-16 08:37 Do-wan Kim Note Added: 0071914
2013-12-16 08:37 Do-wan Kim Status resolved => closed