+ SEH support for Win32. Enable by cycling with OPT=-dTEST_WIN32_SEH.

Although basic things work (no regressions in test suite, also with TEST_OPT=-O2), there are some secondary issues/TODOs:
- Exception frame around PASCALMAIN is not properly removed in DLLs
- No stack traces yet
- Stack overallocated in finalizer procedures, their entry/exit code needs cleanup
- Signals unit is probably completely broken.

git-svn-id: trunk@26225 -

.gitattributes

@@ -204,6 +204,7 @@ compiler/i386/i386prop.inc svneol=native#text/plain
 compiler/i386/i386tab.inc svneol=native#text/plain
 compiler/i386/n386add.pas svneol=native#text/plain
 compiler/i386/n386cal.pas svneol=native#text/plain
+compiler/i386/n386flw.pas svneol=native#text/plain
 compiler/i386/n386inl.pas svneol=native#text/plain
 compiler/i386/n386mat.pas svneol=native#text/plain
 compiler/i386/n386mem.pas svneol=native#text/plain
@@ -9112,6 +9113,7 @@ rtl/win32/gprt0.as svneol=native#text/plain
 rtl/win32/initc.pp svneol=native#text/plain
 rtl/win32/objinc.inc svneol=native#text/plain
 rtl/win32/rtldefs.inc svneol=native#text/plain
+rtl/win32/seh32.inc svneol=native#text/plain
 rtl/win32/signals.pp svneol=native#text/plain
 rtl/win32/sysinit.inc svneol=native#text/plain
 rtl/win32/sysinitcyg.pp svneol=native#text/plain

compiler/i386/cgcpu.pas

@@ -294,13 +294,13 @@ unit cgcpu;
 
     procedure tcg386.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);
 
-      procedure increase_fp(a : tcgint);
+      procedure increase_sp(a : tcgint);
         var
           href : treference;
         begin
-          reference_reset_base(href,current_procinfo.framepointer,a,0);
+          reference_reset_base(href,NR_STACK_POINTER_REG,a,0);
           { normally, lea is a better choice than an add }
-          list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,current_procinfo.framepointer));
+          list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,NR_STACK_POINTER_REG));
         end;
 
       var
@@ -314,7 +314,8 @@ unit cgcpu;
         { remove stackframe }
         if not nostackframe then
           begin
-            if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) or
+               (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
               begin
                 stacksize:=current_procinfo.calc_stackframe_size;
                 if (target_info.stackalign>4) and
@@ -325,9 +326,11 @@ unit cgcpu;
                     (po_assembler in current_procinfo.procdef.procoptions)) then
                   stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
                 if stacksize<>0 then
-                  increase_fp(stacksize);
+                  increase_sp(stacksize);
                 if (not paramanager.use_fixed_stack) then
                   internal_restore_regs(list,true);
+                if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
+                  list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
               end
             else
               begin

compiler/i386/cpunode.pas

@@ -54,6 +54,9 @@ unit cpunode;
        n386mem,
        n386set,
        n386inl,
+{$ifdef TEST_WIN32_SEH}
+       n386flw,
+{$endif TEST_WIN32_SEH}
        n386mat
        ;
 

compiler/i386/n386flw.pas

@@ -0,0 +1,680 @@
+{
+    Copyright (c) 2011 by Free Pascal development team
+
+    Generate Win32-specific exception handling code
+
+    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
+    node,nflw,ncgflw,psub;
+
+  type
+    ti386raisenode=class(tcgraisenode)
+      function pass_1 : tnode;override;
+    end;
+
+    ti386onnode=class(tcgonnode)
+      procedure pass_generate_code;override;
+    end;
+
+    ti386tryexceptnode=class(tcgtryexceptnode)
+      procedure pass_generate_code;override;
+    end;
+
+    ti386tryfinallynode=class(tcgtryfinallynode)
+      finalizepi: tcgprocinfo;
+      constructor create(l,r:TNode);override;
+      constructor create_implicit(l,r,_t1:TNode);override;
+      function pass_1: tnode;override;
+      function simplify(forinline: boolean): tnode;override;
+      procedure pass_generate_code;override;
+    end;
+
+implementation
+
+  uses
+    cutils,globtype,globals,verbose,systems,
+    nbas,ncal,nmem,nutils,
+    symconst,symbase,symtable,symsym,symdef,
+    cgbase,cgobj,cgcpu,cgutils,tgobj,
+    cpubase,htypechk,
+    parabase,paramgr,pdecsub,pass_1,pass_2,ncgutil,cga,
+    aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi;
+
+  var
+    endexceptlabel: tasmlabel;
+
+
+{ ti386raisenode }
+
+function ti386raisenode.pass_1 : tnode;
+  var
+    statements : tstatementnode;
+    raisenode : tcallnode;
+  begin
+    { difference from generic code is that address stack is not popped on reraise }
+    if (target_info.system<>system_i386_win32) or assigned(left) then
+      result:=inherited pass_1
+    else
+      begin
+        result:=internalstatements(statements);
+        raisenode:=ccallnode.createintern('fpc_reraise',nil);
+        include(raisenode.callnodeflags,cnf_call_never_returns);
+        addstatement(statements,raisenode);
+      end;
+end;
+
+{ ti386onnode }
+
+procedure ti386onnode.pass_generate_code;
+  var
+    oldflowcontrol : tflowcontrol;
+    exceptvarsym : tlocalvarsym;
+  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:=flowcontrol*[fc_unwind]+[fc_inflowcontrol];
+
+    { RTL will put exceptobject into EAX when jumping here }
+    cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+
+    { Retrieve exception variable }
+    if assigned(excepTSymtable) then
+      exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
+    else
+      exceptvarsym:=nil;
+
+    if assigned(exceptvarsym) then
+      begin
+        exceptvarsym.localloc.loc:=LOC_REFERENCE;
+        exceptvarsym.localloc.size:=OS_ADDR;
+        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);
+
+    if assigned(right) then
+      secondpass(right);
+
+    { deallocate exception symbol }
+    if assigned(exceptvarsym) then
+      begin
+        tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
+        exceptvarsym.localloc.loc:=LOC_INVALID;
+      end;
+    cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+    cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+
+    flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]);
+  end;
+
+{ ti386tryfinallynode }
+
+function reset_regvars(var n: tnode; arg: pointer): foreachnoderesult;
+  begin
+    case n.nodetype of
+      temprefn:
+        make_not_regable(n,[]);
+      calln:
+        include(tprocinfo(arg).flags,pi_do_call);
+    end;
+    result:=fen_true;
+  end;
+
+function copy_parasize(var n: tnode; arg: pointer): foreachnoderesult;
+  begin
+    case n.nodetype of
+      calln:
+        tcgprocinfo(arg).allocate_push_parasize(tcallnode(n).pushed_parasize);
+    end;
+    result:=fen_true;
+  end;
+
+constructor ti386tryfinallynode.create(l, r: TNode);
+  begin
+    inherited create(l,r);
+    if (target_info.system<>system_i386_win32) or (
+      { Don't create child procedures for generic methods, their nested-like
+        behavior causes compilation errors because real nested procedures
+        aren't allowed for generics. Not creating them doesn't harm because
+        generic node tree is discarded without generating code. }
+        assigned(current_procinfo.procdef.struct) and
+        (df_generic in current_procinfo.procdef.struct.defoptions)
+      ) then
+      exit;
+    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
+    finalizepi.force_nested;
+    finalizepi.procdef:=create_finalizer_procdef;
+    finalizepi.entrypos:=r.fileinfo;
+    finalizepi.entryswitches:=r.localswitches;
+    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
+    finalizepi.exitswitches:=current_settings.localswitches;
+    { Regvar optimization for symbols is suppressed when using exceptions, but
+      temps may be still placed into registers. This must be fixed. }
+    foreachnodestatic(r,@reset_regvars,finalizepi);
+  end;
+
+constructor ti386tryfinallynode.create_implicit(l, r, _t1: TNode);
+  begin
+    inherited create_implicit(l, r, _t1);
+    if (target_info.system<>system_i386_win32) then
+      exit;
+
+    { safecall procedures can handle implicit finalization as part of "except" flow }
+    if implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall) then
+      exit;
+
+    if assigned(current_procinfo.procdef.struct) and
+      (df_generic in current_procinfo.procdef.struct.defoptions) then
+      InternalError(2013012501);
+
+    finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
+    finalizepi.force_nested;
+    finalizepi.procdef:=create_finalizer_procdef;
+    finalizepi.entrypos:=current_filepos;
+    finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
+    finalizepi.entryswitches:=r.localswitches;
+    finalizepi.exitswitches:=current_settings.localswitches;
+    include(finalizepi.flags,pi_has_assembler_block);
+    include(finalizepi.flags,pi_do_call);
+  end;
+
+
+function ti386tryfinallynode.pass_1: tnode;
+  var
+    selfsym: tparavarsym;
+  begin
+    result:=inherited pass_1;
+    if (target_info.system=system_i386_win32) then
+      begin
+        { safecall method will access 'self' from except block -> make it non-regable }
+        if implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall) and
+          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);
+            selfsym.varregable:=vr_none;
+          end;
+      end;
+  end;
+
+
+function ti386tryfinallynode.simplify(forinline: boolean): tnode;
+  begin
+    result:=inherited simplify(forinline);
+    if (target_info.system<>system_i386_win32) then
+      exit;
+
+    if (result=nil) and assigned(finalizepi) then
+      begin
+        finalizepi.code:=right;
+        foreachnodestatic(right,@copy_parasize,finalizepi);
+        right:=ccallnode.create(nil,tprocsym(finalizepi.procdef.procsym),nil,nil,[]);
+        firstpass(right);
+        { For implicit frames, no actual code is available at this time,
+          it is added later in assembler form. So store the nested procinfo
+          for later use. }
+        if implicitframe then
+          begin
+            current_procinfo.finalize_procinfo:=finalizepi;
+            { don't leave dangling pointer }
+            tcgprocinfo(current_procinfo).final_asmnode:=nil;
+          end;
+      end;
+  end;
+
+procedure emit_scope_start(handler,data: TAsmSymbol);
+  var
+    href: treference;
+    hreg: tregister;
+  begin
+    hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
+    reference_reset_base(href,hreg,0,sizeof(pint));
+    href.segment:=NR_FS;
+    emit_reg_reg(A_XOR,S_L,hreg,hreg);
+    emit_sym(A_PUSH,S_L,data);
+    emit_reg(A_PUSH,S_L,NR_FRAME_POINTER_REG);
+    emit_sym(A_PUSH,S_L,handler);
+    emit_ref(A_PUSH,S_L,href);
+    emit_reg_ref(A_MOV,S_L,NR_ESP,href);
+  end;
+
+procedure emit_scope_end;
+  var
+    href: treference;
+    hreg,hreg2: tregister;
+  begin
+    hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
+    hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
+    reference_reset_base(href,hreg,0,sizeof(pint));
+    href.segment:=NR_FS;
+    emit_reg_reg(A_XOR,S_L,hreg,hreg);
+    emit_reg(A_POP,S_L,hreg2);
+    emit_const_reg(A_ADD,S_L,3*sizeof(pint),NR_ESP);
+    emit_reg_ref(A_MOV,S_L,hreg2,href);
+  end;
+
+procedure ti386tryfinallynode.pass_generate_code;
+  var
+    finallylabel,
+    exceptlabel,
+    safecalllabel,
+    endfinallylabel,
+    exitfinallylabel,
+    continuefinallylabel,
+    breakfinallylabel,
+    oldCurrExitLabel,
+    oldContinueLabel,
+    oldBreakLabel : tasmlabel;
+    oldflowcontrol,tryflowcontrol : tflowcontrol;
+    is_safecall: boolean;
+    hreg: tregister;
+  begin
+    if (target_info.system<>system_i386_win32) then
+      begin
+        inherited pass_generate_code;
+        exit;
+      end;
+    location_reset(location,LOC_VOID,OS_NO);
+    tryflowcontrol:=[];
+    oldBreakLabel:=nil;
+    oldContinueLabel:=nil;
+    continuefinallylabel:=nil;
+    breakfinallylabel:=nil;
+    exceptlabel:=nil;
+    safecalllabel:=nil;
+    is_safecall:=implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall);
+
+    { check if child nodes do a break/continue/exit }
+    oldflowcontrol:=flowcontrol;
+    flowcontrol:=[fc_inflowcontrol];
+    current_asmdata.getjumplabel(finallylabel);
+    current_asmdata.getjumplabel(endfinallylabel);
+
+    { 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;
+
+    { Start of scope }
+    if is_safecall then
+      begin
+        with cg.rg[R_INTREGISTER] do
+          used_in_proc:=used_in_proc+[RS_EBX,RS_ESI,RS_EDI];
+
+        current_asmdata.getjumplabel(exceptlabel);
+        emit_scope_start(
+          current_asmdata.RefAsmSymbol('__FPC_except_safecall'),
+          exceptlabel
+        );
+      end
+    else
+      emit_scope_start(
+        current_asmdata.RefAsmSymbol('__FPC_finally_handler'),
+        current_asmdata.RefAsmSymbol(finalizepi.procdef.mangledname)
+      );
+
+    { 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);
+    emit_scope_end;
+    if is_safecall then
+      begin
+        current_asmdata.getjumplabel(safecalllabel);
+        hreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
+        cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg);
+        cg.a_jmp_always(current_asmdata.CurrAsmList,safecalllabel);
+        { RTL handler will jump here on exception }
+        cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
+        handle_safecall_exception;
+        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG,hreg);
+        cg.a_label(current_asmdata.CurrAsmList,safecalllabel);
+      end;
+
+    { end cleanup }
+    current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+    { generate finally code as a separate procedure }
+    { !!! this resets flowcontrol, how to check flow away? }
+    if not implicitframe then
+      tcgprocinfo(current_procinfo).generate_exceptfilter(finalizepi);
+
+    flowcontrol:=[fc_inflowcontrol];
+    { right is a call to finalizer procedure }
+    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));
+
+    if not implicitframe then
+      begin
+        if tryflowcontrol*[fc_exit,fc_break,fc_continue]<>[] then
+          cg.a_jmp_always(current_asmdata.CurrAsmList,endfinallylabel);
+        { 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_call(current_asmdata.CurrAsmList,'_FPC_leave');
+            cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+          end;
+        if fc_break in tryflowcontrol then
+          begin
+            cg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
+            cg.g_call(current_asmdata.CurrAsmList,'_FPC_leave');
+            cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+          end;
+        if fc_continue in tryflowcontrol then
+          begin
+            cg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
+            cg.g_call(current_asmdata.CurrAsmList,'_FPC_leave');
+            cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+          end;
+      end;
+    if is_safecall then
+      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,hreg,NR_FUNCTION_RETURN_REG);
+    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;
+
+{ ti386tryexceptnode }
+
+procedure ti386tryexceptnode.pass_generate_code;
+  var
+    exceptlabel,oldendexceptlabel,
+    lastonlabel,
+    exitexceptlabel,
+    continueexceptlabel,
+    breakexceptlabel,
+    exittrylabel,
+    continuetrylabel,
+    breaktrylabel,
+    oldCurrExitLabel,
+    oldContinueLabel,
+    oldBreakLabel : tasmlabel;
+    onlabel,
+    filterlabel: tasmlabel;
+    oldflowcontrol,tryflowcontrol,
+    exceptflowcontrol : tflowcontrol;
+    hnode : tnode;
+    hlist : tasmlist;
+    onnodecount : tai_const;
+  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;
+
+    { Win32 SEH unwinding does not preserve registers. Indicate that they are
+      going to be destroyed. }
+    cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,[RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]);
+    cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,[RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]);
+
+    { 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(endexceptlabel);
+    current_asmdata.getjumplabel(lastonlabel);
+    filterlabel:=nil;
+
+    { start of scope }
+    if assigned(right) then
+      begin
+        current_asmdata.getdatalabel(filterlabel);
+        emit_scope_start(
+          current_asmdata.RefAsmSymbol('__FPC_on_handler'),
+          filterlabel);
+      end
+    else
+      emit_scope_start(
+        current_asmdata.RefAsmSymbol('__FPC_except_handler'),
+        exceptlabel);
+
+    { 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;
+
+    secondpass(left);
+    tryflowcontrol:=flowcontrol;
+    if codegenerror then
+      goto errorexit;
+
+    emit_scope_end;
+    { jump over except handlers }
+    cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+
+    if fc_exit in tryflowcontrol then
+      begin
+        cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
+        emit_scope_end;
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+      end;
+    if fc_break in tryflowcontrol then
+      begin
+        cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
+        emit_scope_end;
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+      end;
+    if fc_continue in tryflowcontrol then
+      begin
+        cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
+        emit_scope_end;
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+      end;
+
+    { target for catch-all handler }
+    cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
+
+    { 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
+      begin
+        { emit filter table to a temporary asmlist }
+        hlist:=TAsmList.Create;
+        new_section(hlist,sec_rodata,filterlabel.name,4);
+        cg.a_label(hlist,filterlabel);
+        onnodecount:=tai_const.create_32bit(0);
+        hlist.concat(onnodecount);
+
+        hnode:=right;
+        while assigned(hnode) do
+          begin
+            if hnode.nodetype<>onn then
+              InternalError(2011103101);
+            { TODO: make it done without using global label }
+            current_asmdata.getglobaljumplabel(onlabel);
+            hlist.concat(tai_const.create_sym(current_asmdata.RefAsmSymbol(tonnode(hnode).excepttype.vmt_mangledname,AT_DATA)));
+            hlist.concat(tai_const.create_sym(onlabel));
+            cg.a_label(current_asmdata.CurrAsmList,onlabel);
+            secondpass(hnode);
+            inc(onnodecount.value);
+            hnode:=tonnode(hnode).left;
+          end;
+        { add 'else' node to the filter list, too }
+        if assigned(t1) then
+          begin
+            hlist.concat(tai_const.create_32bit(-1));
+            hlist.concat(tai_const.create_sym(lastonlabel));
+            inc(onnodecount.value);
+          end;
+        { now move filter table to permanent list all at once }
+        maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
+        current_asmdata.asmlists[al_typedconsts].concatlist(hlist);
+        hlist.free;
+      end;
+
+    cg.a_label(current_asmdata.CurrAsmList,lastonlabel);
+    if assigned(t1) then
+      begin
+        { here we don't have to reset flowcontrol           }
+        { the default and on flowcontrols are handled equal }
+        secondpass(t1);
+        cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+        if (flowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then
+          cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+      end;
+    exceptflowcontrol:=flowcontrol;
+
+    if fc_exit in exceptflowcontrol then
+      begin
+        { do some magic for exit in the try block }
+        cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
+        cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+      end;
+
+    if fc_break in exceptflowcontrol then
+      begin
+        cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
+        cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+      end;
+
+    if fc_continue in exceptflowcontrol then
+      begin
+        cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
+        cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+        cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+      end;
+
+    cg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
+
+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;
+
+initialization
+  craisenode:=ti386raisenode;
+  connode:=ti386onnode;
+  ctryexceptnode:=ti386tryexceptnode;
+  ctryfinallynode:=ti386tryfinallynode;
+end.

compiler/options.pas

@@ -3449,6 +3449,11 @@ if (target_info.abi = abi_eabihf) then
       def_system_macro('FPC_USE_WIN64_SEH');
 {$endif DISABLE_WIN64_SEH}
 
+{$ifdef TEST_WIN32_SEH}
+    if target_info.system=system_i386_win32 then
+      def_system_macro('FPC_USE_WIN32_SEH');
+{$endif TEST_WIN32_SEH}
+
 {$ifdef ARM}
   { define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL }
   if (init_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) and

compiler/x86/cgx86.pas

@@ -2569,7 +2569,6 @@ unit cgx86;
     procedure tcgx86.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
       var
         stackmisalignment: longint;
-        para: tparavarsym;
         regsize: longint;
 {$ifdef i8086}
         dgroup: treference;
@@ -2651,7 +2650,18 @@ unit cgx86;
                 { Return address and FP are both on stack }
                 current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint));
                 current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint)));
-                list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG));
+                if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then
+                  list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG))
+                else
+                  begin
+                    push_regs;
+                    gen_load_frame_for_exceptfilter(list);
+                    { Need only as much stack space as necessary to do the calls.
+                      Exception filters don't have own local vars, and temps are 'mapped'
+                      to the parent procedure.
+                      maxpushedparasize is already aligned at least on x86_64. }
+                    //localsize:=current_procinfo.maxpushedparasize;
+                  end;
                 current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG);
               end;
 
@@ -2672,7 +2682,8 @@ unit cgx86;
 
 {$ifdef i386}
             if (not paramanager.use_fixed_stack) and
-               (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
+               (current_procinfo.framepointer<>NR_STACK_POINTER_REG) and
+               (current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then
               begin
                 regsize:=0;
                 push_regs;

rtl/inc/except.inc

@@ -397,10 +397,12 @@ begin
 end;
 
 
+{$ifndef FPC_SYSTEM_HAS_DONEEXCEPTION}
 procedure fpc_doneexception;[public,alias:'FPC_DONEEXCEPTION'] compilerproc;
 begin
   Internal_PopObjectStack.Free;
 end;
+{$endif FPC_SYSTEM_HAS_DONEEXCEPTION}
 
 procedure fpc_raise_nested;[public,alias:'FPC_RAISE_NESTED']compilerproc;
 begin
@@ -408,6 +410,7 @@ begin
   Internal_Reraise;
 end;
 
+{$ifndef FPC_SYSTEM_HAS_SAFECALLHANDLER}
 function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
 var
   raiselist: PExceptObject;
@@ -426,4 +429,5 @@ begin
     result:=E_UNEXPECTED;
   exc.Free;
 end;
+{$endif FPC_SYSTEM_HAS_SAFECALLHANDLER}
 

rtl/inc/objpash.inc

@@ -333,6 +333,10 @@
          refcount   : Longint;
          Framecount : Longint;
          Frames     : PCodePointer;
+{$ifdef FPC_USE_WIN32_SEH}
+         SEHFrame   : Pointer;
+         ReraiseBuf : jmp_buf;
+{$endif FPC_USE_WIN32_SEH}
        end;
 
     Const

rtl/win/systhrd.inc

@@ -225,12 +225,12 @@ var
 {$ifdef DEBUG_MT}
         writeln('Jumping to thread function of thread ',Win32GetCurrentThreadId);
 {$endif DEBUG_MT}
-{$ifdef FPC_USE_WIN64_SEH}
+{$if defined(FPC_USE_WIN64_SEH) or defined(FPC_USE_WIN32_SEH)}
         { use special 'top-level' exception handler around the thread function }
         ThreadMain:=main_wrapper(ti.p,pointer(ti.f));
 {$else FPC_USE_WIN64_SEH}
         ThreadMain:=ti.f(ti.p);
-{$endif FPC_USE_WIN64_SEH}
+{$endif FPC_USE_WIN64_SEH or FPC_USE_WIN32_SEH}
       end;
 
 

rtl/win32/seh32.inc

@@ -0,0 +1,365 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2013 by Free Pascal development team
+
+    Support for 32-bit Windows exception handling
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+const
+  EXCEPTION_UNWIND = EXCEPTION_UNWINDING or EXCEPTION_EXIT_UNWIND;
+
+type
+  TDispatcherContext=record
+  end;
+
+  PSEHFrame=^TSEHFrame;
+  TSEHFrame=record
+    Next: PSEHFrame;
+    Addr: Pointer;
+    _EBP: PtrUint;
+    HandlerArg: Pointer;
+  end;
+
+
+procedure RtlUnwind(
+  TargetFrame: Pointer;
+  TargetIp: Pointer;
+  ExceptionRecord: PExceptionRecord;
+  ReturnValue: Pointer);
+  stdcall; external 'kernel32.dll' name 'RtlUnwind';
+
+{$ifdef FPC_USE_WIN32_SEH}
+function NullHandler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl;
+begin
+  result:=ExceptionContinueSearch;
+end;
+
+
+function GetBacktrace(Context: TContext; StartingFrame: Pointer; out Frames: PPointer): Longint;
+begin
+  // TODO
+  Frames:=nil;
+  result:=0;
+end;
+
+
+function fpc_RaiseException(Obj: TObject; AnAddr,AFrame: Pointer): TObject; [public,alias: 'FPC_RAISEEXCEPTION']; compilerproc;
+var
+  ctx: TContext;
+  args: array[0..3] of PtrUint;
+begin
+  //RtlCaptureContext(ctx);
+  args[0]:=PtrUint(AnAddr);
+  args[1]:=PtrUint(Obj);
+  args[2]:=GetBacktrace(ctx,AFrame,PPointer(args[3]));
+  RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]);
+  result:=nil;
+end;
+
+
+procedure fpc_reraise; [public,alias:'FPC_RERAISE']; compilerproc;
+var
+  hp: PExceptObject;
+begin
+  hp:=ExceptObjectStack;
+  ExceptObjectStack:=hp^.next;
+  TSEHFrame(hp^.SEHFrame^).Addr:=@NullHandler;
+  longjmp(hp^.ReraiseBuf,1);
+end;
+
+
+{ Parameters are dummy and used to force "ret 16" at the end;
+  this removes a TSEHFrame record from the stack }
+procedure _fpc_leave(a1,a2,a3,a4:pointer); [public,alias:'_FPC_leave']; stdcall; compilerproc; assembler; nostackframe;
+asm
+     movl   4(%esp),%eax
+     movl   %eax,%fs:(0)
+     movl   %ebp,%eax
+     call   16(%esp)
+end;
+
+
+function PopObjectStack: PExceptObject;
+var
+  hp: PExceptObject;
+begin
+  hp:=ExceptObjectStack;
+  if hp=nil then
+    halt(255)
+  else
+  begin
+    ExceptObjectStack:=hp^.next;
+    if assigned(hp^.frames) then
+      freemem(hp^.frames);
+  end;
+  result:=hp;
+end;
+
+
+function __FPC_finally_handler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_finally_handler'];
+begin
+  if (rec.ExceptionFlags and EXCEPTION_UNWIND)<>0 then
+  begin
+    { prevent endless loop if things go bad in user routine }
+    frame.Addr:=@NullHandler;
+    TUnwindProc(frame.HandlerArg)(frame._EBP);
+  end;
+  result:=ExceptionContinueSearch;
+end;
+
+
+function __FPC_default_handler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_DEFAULT_HANDLER'];
+var
+  code: longint;
+  Obj: TObject;
+  Adr: Pointer;
+begin
+  if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
+  begin
+    RtlUnwind(@frame,nil,@rec,nil);
+    if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
+    begin
+      code:=RunErrorCode(rec);
+      if code<0 then
+        SysResetFPU;
+      Adr:=rec.ExceptionAddress;
+      Obj:=nil;
+      if Assigned(ExceptObjProc) then
+        Obj:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec));
+      if Obj=nil then
+        RunError(abs(code));
+    end
+    else
+    begin
+      Obj:=TObject(rec.ExceptionInformation[1]);
+      Adr:=rec.ExceptionInformation[0];
+      code:=217;
+    end;
+    if Assigned(ExceptProc) then
+    begin
+      ExceptProc(Obj,Adr,0,nil {TODO: backtrace});
+      Halt(217);
+    end
+    else
+      RunError(abs(code));
+  end;
+  result:=ExceptionContinueExecution;
+end;
+
+
+function NestedHandler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl;
+var
+  hp: PExceptObject;
+begin
+  if (rec.ExceptionFlags and EXCEPTION_UNWIND)<>0 then
+  begin
+    hp:=PopObjectStack;
+    if hp^.refcount=0 then
+      hp^.FObject.Free;
+  end;
+  result:=ExceptionContinueSearch;
+end;
+
+function __FPC_except_safecall(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; forward;
+
+procedure CommonHandler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  TargetAddr: Pointer);
+var
+  Exc: TExceptObject;
+  code: Longint;
+begin
+  if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
+  begin
+    Exc.FObject:=nil;
+    code:=RunErrorCode(rec);
+    if Assigned(ExceptObjProc) then
+      Exc.FObject:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec));
+    if (Exc.FObject=nil) and (frame.Addr<>Pointer(@__FPC_except_safecall)) then
+      Exit;
+    Exc.Addr:=rec.ExceptionAddress;
+    Exc.FrameCount:=GetBacktrace(context,nil,Exc.Frames);
+    if code<0 then
+      SysResetFPU;
+  end
+  else
+  begin
+    Exc.Addr:=rec.ExceptionInformation[0];
+    Exc.FObject:=TObject(rec.ExceptionInformation[1]);
+    Exc.Framecount:=Longint(PtrUInt(rec.ExceptionInformation[2]));
+    Exc.Frames:=rec.ExceptionInformation[3];
+  end;
+
+  RtlUnwind(@frame,nil,@rec,nil);
+
+  Exc.Refcount:=0;
+  Exc.SEHFrame:=@frame;
+  { link to ExceptObjectStack }
+  Exc.Next:=ExceptObjectStack;
+  ExceptObjectStack:=@Exc;
+
+  frame.Addr:=@NestedHandler;
+  if setjmp(Exc.ReraiseBuf)=0 then
+  asm
+      movl   Exc.FObject,%eax
+      movl   frame,%edx
+      movl   TargetAddr,%ecx              // load ebp-based var before changing ebp
+      movl   TSEHFrame._EBP(%edx),%ebp
+      jmpl   *%ecx
+  end;
+  { control comes here if exception is re-raised }
+  rec.ExceptionFlags:=rec.ExceptionFlags and (not EXCEPTION_UNWINDING);
+end;
+
+
+function __FPC_except_handler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_except_handler'];
+begin
+  if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
+  begin
+    { Athlon prefetch bug? }
+    if (rec.ExceptionCode=STATUS_ACCESS_VIOLATION) and
+      is_prefetch(pointer(Context.eip)) then
+    begin
+      result:=ExceptionContinueExecution;
+      exit;
+    end;
+    CommonHandler(rec,frame,context,frame.HandlerArg);
+  end;
+  result:=ExceptionContinueSearch;
+end;
+
+{ Safecall procedures are expected to handle OS exceptions even if they cannot be
+  converted to language exceptions. This is indicated by distinct handler address. }
+function __FPC_except_safecall(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_except_safecall']; assembler; nostackframe;
+asm
+    jmp  __FPC_except_handler
+end;
+
+
+function __FPC_on_handler(
+  var rec: TExceptionRecord;
+  var frame: TSEHFrame;
+  var context: TContext;
+  var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_on_handler'];
+var
+  TargetAddr: Pointer;
+begin
+  if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
+  begin
+    { Athlon prefetch bug? }
+    if (rec.ExceptionCode=STATUS_ACCESS_VIOLATION) and
+      is_prefetch(pointer(Context.eip)) then
+    begin
+      result:=ExceptionContinueExecution;
+      exit;
+    end;
+    { Are we going to catch it? }
+    TargetAddr:=FilterException(rec,0,PtrUInt(frame.HandlerArg));
+    if assigned(TargetAddr) then
+      CommonHandler(rec,frame,context,TargetAddr);
+  end;
+  result:=ExceptionContinueSearch;
+end;
+
+
+function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
+var
+  hp: PExceptObject;
+  exc: TObject;
+begin
+  hp:=PopObjectStack;
+  exc:=hp^.FObject;
+  if Assigned(obj) and Assigned(exc) then
+    result:=obj.SafeCallException(exc,hp^.Addr)
+  else
+    result:=E_UNEXPECTED;
+  if hp^.refcount=0 then
+    exc.Free;
+  asm
+       movl   %ebp,%edx                             // save current frame
+       movl   hp,%ecx
+       movl   TExceptObject.SEHFrame(%ecx),%ecx     // target ESP minus sizeof(TSEHFrame)
+       movl   (%ecx),%eax
+       movl   %eax,%fs:(0)                          // restore SEH chain
+       movl   __RESULT,%eax
+       movl   TSEHFrame._EBP(%ecx),%ebp             // restore EBP
+       leal   16(%ecx),%esp                         // restore ESP past the SEH frame
+       jmpl   4(%edx)                               // jump to caller
+  end;
+end;
+
+
+procedure fpc_doneexception;[public,alias:'FPC_DONEEXCEPTION'] compilerproc;
+var
+  hp: PExceptObject;
+begin
+  hp:=PopObjectStack;
+  if hp^.refcount=0 then
+    hp^.FObject.Free;
+  erroraddr:=nil;
+    asm
+        movl   %ebp,%edx                             // save current frame
+        movl   hp,%eax
+        movl   TExceptObject.SEHFrame(%eax),%eax     // target ESP minus sizeof(TSEHFrame)
+        movl   (%eax),%ecx
+        movl   %ecx,%fs:(0)                          // restore SEH chain
+        movl   TSEHFrame._EBP(%eax),%ebp             // restore EBP
+        leal   16(%eax),%esp                         // restore ESP, removing SEH frame
+        jmpl   4(%edx)                               // jump to caller
+    end;
+end;
+
+
+function main_wrapper(arg: Pointer; proc: Pointer): ptrint; assembler; nostackframe;
+asm
+    xorl    %ecx,%ecx
+    pushl   $__FPC_default_handler
+    pushl   %fs:(%ecx)
+    movl    %esp,%fs:(%ecx)
+    call    *%edx
+    xorl    %ecx,%ecx
+    popl    %edx
+    movl    %edx,%fs:(%ecx)
+    popl    %ecx
+end;
+
+{$endif FPC_USE_WIN32_SEH}
+

rtl/win32/system.pp

@@ -29,6 +29,13 @@ interface
 {$define DISABLE_NO_THREAD_MANAGER}
 {$define HAS_WIDESTRINGMANAGER}
 
+{$ifdef FPC_USE_WIN32_SEH}
+  {$define FPC_SYSTEM_HAS_RAISEEXCEPTION}
+  {$define FPC_SYSTEM_HAS_RERAISE}
+  {$define FPC_SYSTEM_HAS_DONEEXCEPTION}
+  {$define FPC_SYSTEM_HAS_SAFECALLHANDLER}
+{$endif FPC_USE_WIN32_SEH}
+
 { include system-independent routine headers }
 {$I systemh.inc}
 
@@ -138,6 +145,11 @@ const
     valgrind_used : false;
     );
 
+{$ifdef FPC_USE_WIN32_SEH}
+function main_wrapper(arg: Pointer; proc: Pointer): ptrint; forward;
+procedure OutermostHandler; external name '__FPC_DEFAULT_HANDLER';
+{$endif FPC_USE_WIN32_SEH}
+
 { include system independent routines }
 {$I system.inc}
 
@@ -177,8 +189,10 @@ begin
      { what about Input and Output ?? PM }
      { now handled, FPK }
    end;
+{$ifndef FPC_USE_WIN32_SEH}
   if not IsLibrary then
     remove_exception_handlers;
+{$endif FPC_USE_WIN32_SEH}
 
   { do cleanup required by the startup code }
   EntryInformation.asm_exit();
@@ -194,24 +208,30 @@ var
 
 procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
   var
-    ST : pointer;
+    xframe: TEXCEPTION_FRAME;
   begin
      EntryInformation:=info;
      IsLibrary:=false;
      { install the handlers for exe only ?
        or should we install them for DLL also ? (PM) }
+{$ifndef FPC_USE_WIN32_SEH}
      install_exception_handlers;
+{$endif FPC_USE_WIN32_SEH}
      { This strange construction is needed to solve the _SS problem
        with a smartlinked syswin32 (PFV) }
      asm
-         { allocate space for an exception frame }
-        pushl $0
-        pushl %fs:(0)
         { movl  %esp,%fs:(0)
           but don't insert it as it doesn't
           point to anything yet
           this will be used in signals unit }
-        movl %esp,%eax
+        leal xframe,%eax
+{$ifndef FPC_USE_WIN32_SEH}
+        movl $0,TException_Frame.handler(%eax)
+{$else}
+        movl $OutermostHandler,TException_Frame.handler(%eax)
+{$endif FPC_USE_WIN32_SEH}
+        movl %fs:(0),%ecx
+        movl %ecx,TException_Frame.next(%eax)
         movl %eax,System_exception_frame
         pushl %ebp
         xorl %eax,%eax
@@ -348,6 +368,8 @@ type
 { type of functions that should be used for exception handling }
   TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
 
+{$i seh32.inc}
+
 function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
         stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';