View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0034772 | FPC | Compiler | public | 2018-12-28 14:21 | 2020-10-23 22:00 |
Reporter | Martin Friebe | Assigned To | Sergei Gorelkin | ||
Priority | high | Severity | crash | Reproducibility | always |
Status | resolved | Resolution | fixed | ||
Platform | 64bit Intel | OS | win 10 | ||
Product Version | 3.3.1 | ||||
Summary | 0034772: Win64 (seh) compiled exe crashes, because implicit finally handler is entered twice. | ||||
Description | This happens on Win64 only (seh specific) / *not* tested with the 32 bit seh... See code in "steps to reproduce" compiled with -gh (tested with -gh -gt -gw) crashes. The procedure allocates memory for a local copy of "a: array of integer" When "exit" is executed, _FPC_local_unwind is called. This calls the finally handlers (both the user one, and the implicit one). The following code is generated (-al) >>>>>>>>>>>>>>>>> .seh_handler __FPC_specific_handler,@unwind .seh_handlerdata .long 2 .long 0 .rva .Lj14 .rva .Lj15 .rva P$PROJECT1$_$FOO$array_of_LONGINT_$$_fin$0 .long 0 .rva .Lj9 .rva .Lj10 .rva P$PROJECT1$_$FOO$array_of_LONGINT_$$_fin$1 <<<<<<<<<<<<<<<< Lj10 is BEFORE the call to the implicit finally .Lj10: .Lj11: movq %rbp,%rcx call P$PROJECT1$_$FOO$array_of_LONGINT_$$_fin$1 So after unwind finishes, the implicit finally handler is called a 2nd time (setting a breakpoint in asm proves this). The memory for "a" is attempted to be freed a 2nd time, which crashes the app. | ||||
Steps To Reproduce | program project1; {$mode objfpc} uses Classes; procedure Foo(a: array of integer); begin try writeln(a[0]); if a[0] = 1 then exit; writeln(a[0]); finally writeln(a[0]); end; end; begin foo([1]); end. | ||||
Tags | No tags attached. | ||||
Fixed in Revision | 42673 | ||||
FPCOldBugId | 0 | ||||
FPCTarget | - | ||||
Attached Files |
|
has duplicate | 0037971 | resolved | Sven Barth | Schwerwiegender Fehler im Exception-Handling |
|
i386-win32 (SEH is enabled) works. x86_64-win64 doesn't and produces following exception and its stack trace:$ .\project1.exe 1 1 An unhandled exception occurred at $000000010000E358: EInvalidPointer: Invalid pointer operation $000000010000E358 SYSFREEMEM_FIXED, line 1162 of ../inc/heap.inc $000000010000E52B SYSFREEMEM, line 1227 of ../inc/heap.inc $000000010000CDAA FREEMEM, line 324 of ../inc/heap.inc $0000000100009CB2 TOBJECT__FREEINSTANCE, line 447 of ../inc/objpas.inc $0000000100019507 TFPLIST__DESTROY, line 113 of ../objpas/classes/lists.inc $0000000100009A8F TOBJECT__FREE, line 336 of ../inc/objpas.inc $000000010002FB3C FREEANDNIL, line 160 of ../objpas/sysutils/sysutils.inc $0000000100019C5D TLIST__DESTROY, line 663 of ../objpas/classes/lists.inc $0000000100009A8F TOBJECT__FREE, line 336 of ../inc/objpas.inc $000000010001A235 TTHREADLIST__DESTROY, line 979 of ../objpas/classes/lists.inc $0000000100009A8F TOBJECT__FREE, line 336 of ../inc/objpas.inc $000000010002FB3C FREEANDNIL, line 160 of ../objpas/sysutils/sysutils.inc $0000000100020FE6 COMMONCLEANUP, line 2543 of ../objpas/classes/classes.inc $0000000100029C9E CLASSES_$$_finalize$, line 84 of classes.pp $000000010000C341 FINALIZEUNITS, line 1013 of ../inc/system.inc $000000010000C651 INTERNALEXIT, line 1094 of ../inc/system.inc $000000010000C6FE fpc_do_exit, line 1137 of ../inc/system.inc |
|
|
|
|
|
|
|
Program received signal SIGSEGV, Segmentation fault. 0x000000010000a0ac in TOBJECT__INHERITSFROM (self=0x1195068, ACLASS=0x10003eb80) at ../inc/objpas.inc:621 621 ../inc/objpas.inc: No such file or directory. (gdb) bt #0 0x000000010000a0ac in TOBJECT__INHERITSFROM (self=0x1195068, ACLASS=0x10003eb80) at ../inc/objpas.inc:621 0000001 0x0000000100009813 in fpc_do_is (ACLASS=0x10003eb80, AOBJECT=0x11950b0) at ../inc/objpas.inc:42 0000002 0x0000000100030154 in CATCHUNHANDLEDEXCEPTION (OBJ=0x11950b0, ADDR=0x10000e358, FRAMECOUNT=9, FRAMES=0x11a50d0) at ../objpas/sysutils/sysutils.inc:310 0000003 0x0000000100013ec7 in __FPC_DEFAULT_HANDLER (REC=..., FRAME=0x102feb0, CONTEXT=..., DISPATCH=...) at seh64.inc:422 0000004 0x00000000779281ad in ntdll!RtlDecodePointer () from C:\Windows\SYSTEM32\ntdll.dll 0000005 0x0000000077917ddc in ntdll!RtlUnwindEx () from C:\Windows\SYSTEM32\ntdll.dll 0000006 0x000000007781052e in RtlUnwindEx () from C:\Windows\system32\kernel32.dll 0000007 0x0000000100013cc6 in __FPC_DEFAULT_HANDLER (REC=..., FRAME=0x102feb0, CONTEXT=..., DISPATCH=...) at seh64.inc:396 0000008 0x000000007792812d in ntdll!RtlDecodePointer () from C:\Windows\SYSTEM32\ntdll.dll 0000009 0x000000007791855f in ntdll!RtlUnwindEx () from C:\Windows\SYSTEM32\ntdll.dll 0000010 0x000000007794bcb8 in ntdll!KiUserExceptionDispatcher () from C:\Windows\SYSTEM32\ntdll.dll 0000011 0x000007fefd70a06d in RaiseException () from C:\Windows\system32\KernelBase.dll 0000012 0x000000010001397a in fpc_raiseexception (OBJ=0x11950b0, ANADDR=0x10000e358, AFRAME=0x102fc90) at seh64.inc:293 0000013 0x0000000100030661 in RUNERRORTOEXCEPT (ERRNO=204, ADDRESS=0x10000e358, FRAME=0x102fc90) at ../objpas/sysutils/sysutils.inc:440 0000014 0x000000010000c7c4 in HANDLEERRORADDRFRAME (ERRNO=204, ADDR=0x10000e358, FRAME=0x102fc90) at ../inc/system.inc:1205 0000015 0x000000010000c874 in HANDLEERRORADDRFRAMEIND (ERRNO=204, ADDR=0x10000e358, FRAME=0x102fc90) at ../inc/system.inc:1222 0000016 0x000000010000c89f in fpc_handleerror (ERRNO=204) at ../inc/system.inc:1242 0000017 0x000000010000e358 in SYSFREEMEM_FIXED (LOC_FREELISTS=0x117cc3a, PMC=0x118d038) at ../inc/heap.inc:1162 0000018 0x000000010000e52b in SYSFREEMEM (P=0x118d040) at ../inc/heap.inc:1227 0000019 0x000000010000c6aa in INTERNALEXIT () at ../inc/system.inc:1106 0000020 0x000000010000c6fe in fpc_do_exit () at ../inc/system.inc:1137 0000021 0x000000010000187d in main () at project1.lpr:25 |
|
Just as a note, the same issue would happen with any other data in any other implicit finally handler. (if user try finally blocks are "exit"ed.) Strings and arrays however are set to nil, when de-ref'ed. So they do not crash. Still they should only run once. |
|
The unwind data looks correct, .Lj10 designates the end of 'try' part of implicit try..finally statement. It appears that in procedures with only an implicit try..finally, 'exit' statement generates a plain jump to the end of 'try' part, which allows to entirely avoid unwind-related activities and considerably improves performance. When user try..finally statement is added, 'exit' changes its behavior and generates a call to fpc_local_unwind instead of jump, so that 'finally' part of the inner try..finally can be executed. However the exit label (which becomes the second argument of fpc_local_unwind) looks incorrect in this case, because it is recognized as being outside of outer 'try' statement and unwinding to it calls the finalizer. |
|
Not sure if this is relevant in anyway, but FWIW: While fpc 3.0.4 does not trigger the crash, heaptrace barfs about wrong memory signature: C:\Users\Bart\LazarusProjecten\bugs\Console\seh>seh 1 1 Marked memory at $00000000000EF130 invalid Wrong signature $AAAAAAAA instead of 26C33231 |
|
more simple: program Project1; procedure DoIt(ar: array of const); begin try exit; finally end end; begin DoIt([]); end. |
|
nx64flw.pas.patch (2,794 bytes)
Index: nx64flw.pas =================================================================== --- nx64flw.pas (revision 41795) +++ nx64flw.pas (working copy) @@ -223,6 +223,7 @@ endtrylabel, finallylabel, endfinallylabel, + templabel, oldexitlabel: tasmlabel; oldflowcontrol: tflowcontrol; catch_frame: boolean; @@ -244,6 +245,7 @@ oldflowcontrol:=flowcontrol; flowcontrol:=[fc_inflowcontrol]; + templabel:=nil; current_asmdata.getjumplabel(trylabel); current_asmdata.getjumplabel(endtrylabel); current_asmdata.getjumplabel(finallylabel); @@ -284,20 +286,19 @@ exit; end; - { If the immediately preceding instruction is CALL, - its return address must not end up outside the scope, so pad with NOP. } + { finallylabel is only used in implicit frames as an exit point from nested try..finally + statements, if any. To prevent finalizer from being executed twice, it must come before + endtrylabel (bug #34772) } if catch_frame then - cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel) - else - emit_nop; - - cg.a_label(current_asmdata.CurrAsmList,endtrylabel); - - { Handle the except block first, so endtrylabel serves both - as end of scope and as unwind target. This way it is possible to - encode everything into a single scope record. } - if catch_frame then begin + current_asmdata.getjumplabel(templabel); + cg.a_label(current_asmdata.CurrAsmList, finallylabel); + { jump over exception handler } + cg.a_jmp_always(current_asmdata.CurrAsmList,templabel); + { Handle the except block first, so endtrylabel serves both + as end of scope and as unwind target. This way it is possible to + encode everything into a single scope record. } + cg.a_label(current_asmdata.CurrAsmList,endtrylabel); if (current_procinfo.procdef.proccalloption=pocall_safecall) then begin handle_safecall_exception; @@ -305,10 +306,18 @@ end else InternalError(2014031601); + cg.a_label(current_asmdata.CurrAsmList,templabel); + end + else + begin + { same as emit_nop but using finallylabel instead of dummy } + cg.a_label(current_asmdata.CurrAsmList,finallylabel); + finallylabel.increfs; + current_asmdata.CurrAsmList.concat(Taicpu.op_none(A_NOP,S_NO)); + cg.a_label(current_asmdata.CurrAsmList,endtrylabel); end; flowcontrol:=[fc_inflowcontrol]; - cg.a_label(current_asmdata.CurrAsmList,finallylabel); { generate finally code as a separate procedure } if not implicitframe then tcgprocinfo(current_procinfo).generate_exceptfilter(finalizepi); |
|
|
|
I attached the proposed patch which I made some time time ago, and a test, extended to handle the 'safecall' calling convention. The patch solves the issue, but I didn't run the full test suite with it. Hopefully it saves some work. |
|
I too have a solution that is still being run through the regression tests, but is somewhat different to yours. We may have to make comparisons when all is done. |
|
i34772.patch (2,676 bytes)
Index: compiler/ncgflw.pas =================================================================== --- compiler/ncgflw.pas (revision 41898) +++ compiler/ncgflw.pas (working copy) @@ -424,7 +424,10 @@ secondpass(left); if (fc_unwind_exit in flowcontrol) then - hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel) + { Use TrueExitLabel, not CurrExitLabel, because if there's an implicit finally + block, this will also be inside the unwinding information, and jumping to + CurrExitLabel might call the implicit finally block a second time. [Kit] [Issue #34772] } + hlcg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.TrueExitLabel) else hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel); end; Index: compiler/procinfo.pas =================================================================== --- compiler/procinfo.pas (revision 41898) +++ compiler/procinfo.pas (working copy) @@ -117,6 +117,9 @@ { label to leave the sub routine } CurrExitLabel : tasmlabel; + { True exit label (used as the exit point for stack unwinding on some platforms) } + TrueExitLabel : tasmlabel; + { label for nested exits } nestedexitlabel : tlabelsym; @@ -215,6 +218,7 @@ reference_reset(save_regs_ref,sizeof(aint),[]); { labels } current_asmdata.getjumplabel(CurrExitLabel); + TrueExitLabel := CurrExitLabel; { This label doesn't change } current_asmdata.getjumplabel(CurrGOTLabel); CurrBreakLabel:=nil; CurrContinueLabel:=nil; Index: compiler/x86_64/nx64flw.pas =================================================================== --- compiler/x86_64/nx64flw.pas (revision 41898) +++ compiler/x86_64/nx64flw.pas (working copy) @@ -472,7 +472,10 @@ cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel); cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); if (fc_unwind_exit in oldflowcontrol) then - cg.g_local_unwind(current_asmdata.CurrAsmList,oldCurrExitLabel) + { Use TrueExitLabel, not oldCurrExitLabel, because if there's an implicit finally + block, this will also be inside the unwinding information, and jumping to + oldCurrExitLabel might call the implicit finally block a second time. [Kit] [Issue #34772] } + cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.TrueExitLabel) else cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); end; |
|
I've written my own patch that also fixes the bug, along with a more extensive test to see how the implicit finally block interacts with explicit ones and also except blocks. This is a little awkward because your patch does fix the bug, so I'm interested to know why you didn't upload it before. Not to blow my own trumpet, but I want to say my patch is SLIGHTLY better because it's a little clearer as to what's going on, and it produces slightly more optimal code when it's the implicit finally block by itself: From the if-statement that calls exit: .Ll8: movq -8(%rbp),%rax cmpl $1,(%rax) je .Lj9 ... Your patch does the following: .Lj9: .Ll11: nop .Lj8: movq %rbp,%rcx call P$TW34772$_$TEST1$array_of_LONGINT_$$_fin$00000001 While mine (and the trunk) does this: .Lj17: .Ll11: nop .Lj8: .Lj9: movq %rbp,%rcx call P$TW34772$_$TEST1$array_of_LONGINT_$$_fin$00000001 The jump is after the "nop" not before, so your code makes the final EXE very slightly more inefficient. I hope you don't take it personally. tw34772.pp (12,098 bytes)
program tw34772; {$mode objfpc}{$H+} {$WARN 5058 off : Variable "$1" does not seem to be initialized} uses Classes, SysUtils; procedure Test1(a: array of Integer); begin WriteLn('Test1 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test1 - End ', a[0]); end; procedure Test2(a: array of Integer); var Test: Pointer; begin GetMem(Test, 4); try WriteLn('Test2 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test2 - End ', a[0]); finally FreeMem(Test); WriteLn('Test2 - Finally ', a[0]); end; end; procedure Test3(a: array of Integer); begin try WriteLn('Test3 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test3 - End ', a[0]); except on E: Exception do begin if E.ClassType <> EAbort then raise; { Unexpected exception } WriteLn('Test3 - Except ', a[0]); end; end; end; procedure Test4(a: array of Integer); var Test: Pointer; begin GetMem(Test, 4); try try WriteLn('Test4 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test4 - End ', a[0]); except on E: Exception do begin if E.ClassType <> EAbort then raise; { Unexpected exception } WriteLn('Test4 - Except ', a[0]); end; end; finally FreeMem(Test); WriteLn('Test4 - Finally ', a[0]); end; end; procedure Test5(a: array of Integer); safecall; begin WriteLn('Test5 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test5 - End ', a[0]); end; procedure Test6(a: array of Integer); safecall; var Test: Pointer; begin GetMem(Test, 4); try WriteLn('Test6 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test6 - End ', a[0]); finally FreeMem(Test); WriteLn('Test6 - Finally ', a[0]); end; end; procedure Test7(a: array of Integer); safecall; begin try WriteLn('Test7 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test7 - End ', a[0]); except on E: Exception do begin if E.ClassType <> EAbort then raise; { Unexpected exception } WriteLn('Test7 - Except ', a[0]); end; end; end; procedure Test8(a: array of Integer); safecall; var Test: Pointer; begin GetMem(Test, 4); try try WriteLn('Test8 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test8 - End ', a[0]); except on E: Exception do begin if E.ClassType <> EAbort then raise; { Unexpected exception } WriteLn('Test8 - Except ', a[0]); end; end; finally FreeMem(Test); WriteLn('Test8 - Finally ', a[0]); end; end; function Test9(a: array of Integer): Boolean; var Test: Pointer; begin Result := True; GetMem(Test, 4); try WriteLn('Test9 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test9 - End ', a[0]); finally FreeMem(Test); WriteLn('Test9 - Finally ', a[0]); if a[0] = 0 then Result := False; end; Result := True; end; procedure Test10(a: array of Integer); var Test, Test2: Pointer; begin GetMem(Test, 4); try GetMem(Test2, 4); try WriteLn('Test10 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test10 - End ', a[0]); finally FreeMem(Test2); WriteLn('Test10 - Finally A ', a[0]); end; finally FreeMem(Test); WriteLn('Test10 - Finally B ', a[0]); end; end; procedure Test11(a: array of Integer); safecall; var Test, Test2: Pointer; begin GetMem(Test, 4); try GetMem(Test2, 4); try WriteLn('Test11 - Start ', a[0]); if a[0] = 1 then exit; if a[0] = 2 then raise EAbort.Create('Test'); WriteLn('Test11 - End ', a[0]); finally FreeMem(Test2); WriteLn('Test11 - Finally A ', a[0]); end; finally FreeMem(Test); WriteLn('Test11 - Finally B ', a[0]); end; end; procedure Test12(a: Integer); safecall; var Test, Test2: Pointer; begin GetMem(Test, 4); try GetMem(Test2, 4); try WriteLn('Test12 - Start ', a); if a = 1 then exit; if a = 2 then raise EAbort.Create('Test'); WriteLn('Test12 - End ', a); finally FreeMem(Test2); WriteLn('Test12 - Finally A ', a); end; finally FreeMem(Test); WriteLn('Test12 - Finally B ', a); end; end; var X, TestCount: Integer; ReferenceCount: LongInt; MemMgr, NewMemMgr: TMemoryManager; Fail: Boolean; function HookGetMem(Size: PtrUInt): Pointer; begin Inc(ReferenceCount); Result := MemMgr.GetMem(Size); end; function HookReAllocMem(var p: Pointer; Size: PtrUInt): Pointer; begin if p = nil then Inc(ReferenceCount); Result := MemMgr.ReAllocMem(p, Size); { If ReAllocMem(nil, 0) is called, ReferenceCount is incremented then decremented, reflecting the null operation } if Size = 0 then Dec(ReferenceCount); end; function HookFreeMem(ptr: Pointer): PtrUInt; begin Dec(ReferenceCount); Result := MemMgr.FreeMem(ptr); end; function HookFreeMemSize(ptr: Pointer; Size: PtrUInt): PtrUInt; begin Dec(ReferenceCount); Result := MemMgr.FreeMemSize(ptr, Size); end; procedure PostTestAnalysis; begin Inc(TestCount); if ReferenceCount <> 0 then begin WriteLn('FAIL - Reference count = ', ReferenceCount); Fail := True; end; end; procedure CheckTestCount; begin if TestCount <> 3 then begin Fail := True; WriteLn('FAIL - Only ', TestCount, ' sub-tests were run for this test'); end; end; begin { Set up hooks to track memory leaks } GetMemoryManager(MemMgr); NewMemMgr := MemMgr; NewMemMgr.GetMem := @HookGetMem; NewMemMgr.ReAllocMem := @HookReAllocMem; NewMemMgr.FreeMem := @HookFreeMem; NewMemMgr.FreeMemSize := @HookFreeMemSize; SetMemoryManager(NewMemMgr); { Test parameters [0] = Run to end of procedure [1] = Exit prematurely [2] = raise exception } { Test1 - implicit try..finally } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test1([X]); except on E: Exception do if E.ClassType <> EAbort then begin { Unexpected exception } WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test2 - implicit + explicit try..finally } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test2([X]); except on E: Exception do if E.ClassType <> EAbort then begin { Unexpected exception } WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test3 - implicit try..finally and explicit try..except } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test3([X]); except { Exceptions should be caught } on E: Exception do begin WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test4 - implicit + explicit try..finally and explicit try..except } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test4([X]); except { Exceptions should be caught } on E: Exception do begin WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test5 - implicit try..finally with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test5([X]); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; { Test6 - implicit + explicit try..finally with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test6([X]); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; { Test7 - implicit try..finally and explicit try..except with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test7([X]); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; { Test8 - implicit + explicit try..finally and explicit try..except with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test8([X]); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; { Test9 - implicit + explicit try..finally with code following } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try if not Test9([X]) then begin WriteLn('FAIL - Code following finally block wasn''t executed'); Fail := True; Continue; end; except on E: Exception do if E.ClassType <> EAbort then begin { Unexpected exception } WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test10 - implicit + 2 * explicit try..finally } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test10([X]); except on E: Exception do if E.ClassType <> EAbort then begin { Unexpected exception } WriteLn('FAIL - Exception ', E.ClassName, ' raised: "', E.Message, '"'); Fail := True; Continue; end; end; PostTestAnalysis; end; CheckTestCount; { Test11 - implicit + 2 * explicit try..finally with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test11([X]); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; { Test12 - 2 * explicit try..finally with safecall } TestCount := 0; for X := 0 to 2 do begin ReferenceCount := 0; try Test12(X); except { Everything gets wrapped into a ESafecallException } end; PostTestAnalysis; end; CheckTestCount; if Fail then Halt(1) else WriteLn('ok'); end. |
|
I believe the patch "i34772.patch" now fixes the issue. Can you confirm, Martin Friebe? |
|
I didn't upload the patch immediately after making it, because I was intending to fully test it and then apply it myself, without uploading here. Since I'm the author of Windows SEH support, fixing this bug was my responsibility :) As for efficiency, putting the exitlabel before 'nop' (or, more precisely, at address before .Lj8) was exactly the goal of my patch. The exitlabel (.Lj9) residing at the same address as end of scope (.Lj8) was the reason of wrong behavior, because it considered the outer finalizer a part of inner 'try' part and executed it once during local_unwind, and then the second time during normal execution. Another possible approach is placing the exitlabel after call to implicit finalizer (that probably is what your patch does, from the looks of it), so that both inner and outer finalizers are executed as part of unwind, but that will somewhat slow down execution of 'exit' statement, because runtime will have to interpret two unwind scopes instead of just one. |
|
One thought that sprung to mind as a future optimisation is to not call the unwind routine at all with Exit, but instead just call the finally blocks as regular procedures, since it's not in an error situation. Will that work or am I missing something? |
|
You may miss that 'finally' code is allowed to raise its own exceptions. Correctly handling them while executing 'exit' path outside of unwind may complicate code generation too much, if possible at all. Back when I was writing the SEH support, other compilers, namely Delphi and MSVC did not have such optimization. |
|
Fair enough. Thanks! Regarding my patch, the logic is that TrueExitLabel is set to the procedure's original exit label (since currExitLabel gets changed when it enters a new try block), and it is this that's passed into the unwind procedure as the parameter, whereas before, it was currExitLabel, which was set to the implicit finally block (or otherwise wasn't the true end point), which is also inside the unwind information, hence got called twice. (Also, my patch is slightly more general-purpose in that if another platform introduces stack unwinding, additional plaform-specific code hopefully won't need to be written because of the TrueExitLabel introduction) |
|
Confirmed with Jonas that since Sergei is the maintainer of SEH functionality, the final call as to which patch should be applied is up to him. Sergei, it's in your hands now! |
|
Any feedback on this? Either of the two patches fixes the problem, but until one of them is applied, the trunk compiler will generate bad code in the aforementioned instance. |
|
Applied my patch together with Gareth's test. |
Date Modified | Username | Field | Change |
---|---|---|---|
2018-12-28 14:21 | Martin Friebe | New Issue | |
2018-12-28 16:40 | J. Gareth Moreton | Priority | normal => high |
2018-12-28 16:40 | J. Gareth Moreton | Severity | minor => crash |
2018-12-28 17:11 | Cyrax | Note Added: 0112953 | |
2018-12-28 17:13 | Cyrax | File Added: project1.zip | |
2018-12-28 17:15 | Cyrax | File Added: x86_64-win64_project1.s.zip | |
2018-12-28 17:16 | Cyrax | File Added: i386-win32_project1.s.zip | |
2018-12-28 17:56 | Cyrax | Note Added: 0112955 | |
2018-12-28 18:06 | Martin Friebe | Note Added: 0112957 | |
2018-12-28 22:54 | Sergei Gorelkin | Note Added: 0112966 | |
2018-12-28 23:08 | Sergei Gorelkin | Note Edited: 0112966 | View Revisions |
2018-12-29 18:36 | Bart Broersma | Note Added: 0112985 | |
2019-02-28 12:19 | Snus | Note Added: 0114500 | |
2019-04-19 08:43 | J. Gareth Moreton | Assigned To | => J. Gareth Moreton |
2019-04-19 08:43 | J. Gareth Moreton | Status | new => assigned |
2019-04-19 14:37 | Sergei Gorelkin | File Added: nx64flw.pas.patch | |
2019-04-19 14:38 | Sergei Gorelkin | File Added: 34772.pas | |
2019-04-19 14:41 | Sergei Gorelkin | Note Added: 0115675 | |
2019-04-19 14:51 | J. Gareth Moreton | Note Added: 0115676 | |
2019-04-19 14:52 | J. Gareth Moreton | Note Edited: 0115676 | View Revisions |
2019-04-19 14:52 | J. Gareth Moreton | Note Edited: 0115676 | View Revisions |
2019-04-21 04:31 | J. Gareth Moreton | File Added: i34772.patch | |
2019-04-21 04:31 | J. Gareth Moreton | File Added: tw34772.pp | |
2019-04-21 04:31 | J. Gareth Moreton | Note Added: 0115699 | |
2019-04-21 04:33 | J. Gareth Moreton | Assigned To | J. Gareth Moreton => Martin Friebe |
2019-04-21 04:33 | J. Gareth Moreton | Status | assigned => feedback |
2019-04-21 04:33 | J. Gareth Moreton | Note Added: 0115700 | |
2019-04-21 11:00 | Sergei Gorelkin | Note Added: 0115702 | |
2019-04-21 13:40 | J. Gareth Moreton | Note Added: 0115704 | |
2019-04-21 14:20 | Sergei Gorelkin | Note Added: 0115706 | |
2019-04-21 16:04 | J. Gareth Moreton | Note Added: 0115707 | |
2019-04-21 18:31 | J. Gareth Moreton | Note Edited: 0115707 | View Revisions |
2019-04-22 14:10 | J. Gareth Moreton | Assigned To | Martin Friebe => Sergei Gorelkin |
2019-04-22 14:12 | J. Gareth Moreton | Status | feedback => assigned |
2019-04-22 14:12 | J. Gareth Moreton | Note Added: 0115726 | |
2019-04-22 14:13 | J. Gareth Moreton | Note Edited: 0115707 | View Revisions |
2019-05-15 14:45 | J. Gareth Moreton | Note Added: 0116206 | |
2019-08-13 10:36 | Sergei Gorelkin | Note Added: 0117661 | |
2019-08-13 10:37 | Sergei Gorelkin | Status | assigned => resolved |
2019-08-13 10:37 | Sergei Gorelkin | Resolution | open => fixed |
2019-08-13 10:37 | Sergei Gorelkin | Fixed in Revision | => 42673 |
2019-08-13 10:37 | Sergei Gorelkin | FPCTarget | => - |
2020-10-23 22:00 | Sven Barth | Relationship added | has duplicate 0037971 |